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This appendix to the User Manual for the Streamtube Curvature Analysis con- 
tains the computer program listing. It should be noted that the listing in- 
cludes explanatory statements and titles so that the program flow is readily 
discernable. The computer program listing is in CDC Fortran 2.3 source 
language form, except for three subroutines, GET DC, GE1RIX, and SAVTX, which 
are in Compose 1.1 language. 

( 



n r> r< r> n n r> 


♦DECK MAIN 

OVERLAY! STC, 0,0) 

PROGRAM STCA( INPUT ,OUTPU T , TAPE5 , TAPE 6*0UTPUT » 

♦ TAPE1,TAPE2,TAPEA=TAPE2 ) 

COMMON /BCOMMN/ PROGM, TA P IN, T APOT , RE F 1 5 ) • PROGSV, F I L I N,F IL OT 
LOGICAL TAPIN,TAPOT , FILIN, PILOT 

EOUIVALENCE ( I PROGM, PROGM I 

COMMON /AOAMOI/ NAME < 6 ) , ADDKL S ( 6 ) , T I TLE ( 6 ) , I DENT ( 6 ) 

COMMON / ADAM02/ LNOJOB ,0UM1 { 2 ) , LNOCRD 
LOGICAL. t NDJOB , LNOCRD 

COMMON /CBITS / KITS, BLANK 
EOUIVALENCE ( I BL ANK , BLANK ) 

COMMON /CNTRL / K5 < 8 ) , CARRY , I CHN 
LOGICAL CARRY 

COMMON /IXORIG/ I IDUM( 21 ) ,NM, I I IDUMI II ) 

COMMON /KEYS / KE YA ( 1 1 ) , KE YB ( 1 1 ) , KODA ( 22 ) 

DIMENSION XKEYAlll) 

EQUIVALENCE ( XK E YA ( 1 ) , KE YA (I) ) 

COMMON /TROUBL / E RR, ERRM A J , I NLRR , PRE RR 
LOGICAL ERR,ERRMAJ,INERR,PRERR 

C 

COMMON /CINNER/ I NRC TR ,RDUM, N INNER 1 16 ) ,CNVF ( 16 ) 

COMMON /CMAXIT/ MAX I T , MA JCTR , GREF I N , EDUM 
LOGICAL GREFIN 

COMMON /CPRINT/ PPDUM ( 6 ) , PDUM t 20 ) 

COMMON /CTAPOS/ KE STRT , E NDBD T , S TCF I L , K6SV 
LOGICAL RESTRT.ENDBDT ,STCFIL 

COMMON /CTOLRL / TOLRL , MA X SWP , CL EN , DS2MX , TOLL S2 ,NS WP , 

♦ DS1DMP,DS1MXA,DS1MXB,DS1RMS,ES2MX ,DSIRM0 

♦, SG1MIN,T0LINR 

COMMON /TAPES / N T APO, NT APN 
DIMENSION A A ( 8 ) 

DS 1 DMP = DAMPING FACTOR ON DSI, =0 FOR NO DAMPING, =1 FOR NOMINAL 
DS1MXA= MAX-DSI 

OSIMXB= MAX CALCULATED DSI BEFORE DAMPING 
DS1RMS= RMS OF THE CALCULATED DSi-S 

ES2MX = MAX SL POSITION ERROR AS DETERMINED BY THE FLOW BALANCE 
DS2MX = MAX CALCULATED SL ADJUSTMENT 
NS WP = NUMBER OF LRELAX SWEEPS 
COMMON /SELECT/ LENTRY 
DATA KA/IHA/, KBDY/3HBDY/, STC/3HSTC/ 

DATA I TRUE/ IHT / 

NT APO = 1 
NT APN = 2 
WRIIL 16,7760) 

7760 FORMAT! 1H1 , 22X, 28H* ♦CARO INPUT* *// ) 

•"* c INITIALIZE AFTER READING NAMELISTS ID, DIP 

ENOFILE 6 
REWIND 5 

7777 FORMAT! 1H1 ) 

7778 FORMAT! 8A10) 

7775 READ ! 5 , 7778) AA 

_ IF! EOF, 5 ) 778L, 7776 

7776 WRITE (6,7778) AA 
GO TO 7775 

7781 REWIND 5 
- READ! 5 , 100 1 ) NAME 




RE AD( 5 , 1001 ) AODRfcS 
READ! 5, 1001 ) IDEM 

1001 FORMAT ( 1 X » 6A 10 ) 

READ (5,1002) INI .PROGM, TAPIN, TAPOT 

1002 FORMAT ( I 2 , 1 X , A 10 , L 1 , 9X , L 1 ) 

11 WRITE (6,1100) PROGM,TAP IN, TAPOT 

1100 FORMAT ( IHl, 10X, 16HEXECUTING PROGM*, A6/10X.6HTAPIN- ,L2, 5X, 
* 6HT A POT = , L 2/ ) 

XKEYA ( A ) = PROGM 
PROGSV- PROGM 
6NDCRD= .FALSE. 

E RRMAJ * .FALSE. 

PRERR = .FALSE. 

DO 2 1-1,3 
KEYA( I )» I BLANK 

2 KFYH( 1 )• I BLANK 

3 FILIN - TAPIN 
FILOT « TAPOT 
TAPIN * .FALSE. 

TAPOT * .FALSE. 

ERR « .FALSE. 

DATA I BDY/3HB0Y/ 

K5 * I BDY 

A PROGM = BITS 

8 K5 = KA 
GO TO 12 

C CONSECUTIVE DIP LIST READ 

5 READ (5,1003) INI , IN2, IN3, IN4 

1003 FORMAT( I2,1X,3A10) 

IF( EOF, 5 ) 19,7 

7 GO TO (20,9,10), INI 

9 K5 * KBDY 
K 5 ( 2 ) - IN3 
ICHN * IN4 
GO TO 12 

10 K*> ■ 1N2 

K 5 ( 2 ) - IN3 

C INPUT SECTION ENTRY STCN TO (1,0) 

12 LENTRY- l 
LOVER = l 

CALL 0VERLAY(3HSTC,l,0,6HRECALL> 

IF( ( .NOT. INERR) .AND. (.NOT. ERR) ) GO TO 5 
15 WRITE ( 6, 1004 ) LOVER, LENTRY 

1004 FORMAT (//2X,9HERR = T , 5X, 7HE RRCOD-, 1 2 ,5X,7HLENTRY= , 1 2 ) 

CALL ERRORK ( 6HERR-T ) 

WRITE (6,1000) 

1000 FORMAT! 1H1//10X.26H***** JOB TERMINATED ♦****) 

STOP 

19 ENOJOB- .TRUE. 

C INPUT PROCESSING COMPLETE— BUILD TABLES 

20 LENTRY- 2 
LOVER * 1 

CALL OVERLAY! 3HSTC,i,0,6HRECALL ) 

IF ( ERR ) GO TO 15 
WRITE (6,1140) 




1140 FORMAT! 1H 1/ / L 7X , 3H*** , 17X , 19H SOLUT I ON HI STORY ,20X, 3H***/ 

1 7X» 103HGR ID + INNER «• ORTHOGONAL I Z AT 

2 1 ON ♦ FLOW ♦ MATRIX SOLUTION / 

3 4X, 10HREFINEMENT,9X, 10HI TERATIQNS,41X,7HBALANCE// 

4 2X» 106HNREFIN GRID INRCTR CNVF RMS-DSi MAX-D 

5S1 MAX-DS 1 LIM-ES2 MAX-ES2 MAX-DS2 NSWEEPS /13X, 3HPTS 
6 , 23X , 16H( BEFORE D AMP I MG) , AX ,7H( AFTER )) 


C INITIAL CALCULATION OF DISTANCt ALONG STREAMLINE 
205 L ENTRY- 1 
LOVER = 3 

CALL OVERLAY! 3HSTC, 3,0, 6HRECALL > 

IF(ERR) GO TO 15 
IF! .NUT .RESTRT ) GO TO 210 
RE STK T = .FALSE. 

GREF IN= .TRUE. 

LENTRY= 5 
GO TO 216 
C 

C REFINE GRID — ON FIRST ENTRY INSERT BOWSHOCK 
210 LENTRY= 2 
LOVER * 3 

CALL OVERLAY! 3HSTC ,3,0, 6HRECALL I 
IF(ERR) GO TO 15 
IF! .NOT. GREFIN ) GO TO 2511 
MAJCTR= MAJCTR+1 
INRCTR* 0 
DS2MX = 0. 

NSWP = 0 

C CALCULATE CURV.PH1 ,US1-S. — OKIHOGONALIZE. ADJUST FLOWS GE 215 

215 L ENTR Y = 3 

216 LOVER = 3 

CALL OVERLAY! 3HSTC, 3,0, 6HRECALL I 
IF(ERR) GO TO 15 

C CALCULATE B , RHS — FLOW BALANCE— STATION LOOP — E NTRY-STCB 
225 LENTRY* 1 
LOVER = 2 

CALL OVERLAY! 3HSTC ,2,0, 6HRECALL ) 

IF! ERR ) GO TO 15 
ES2L I M* SG1MIN*T0L INR 

WRITE ! 6, 1010) MAJCTR.NM, INRC TR ,C NVF ( MA JCTR ) , DSi RMS , DS1 MXB , OS 1MX A , 
1 ES2LIM,ES2MX,DS2MX,NSWP 

1010 FORMAT! I 6, I 10, 1 9, F9. 2 , F 1 2 .6 , 2F 1 0. 6, 3F 1 1 . 6 , 1 6 ) 

IF! INRCTR. EQ.O .OR. ! E S2MX.GE .E S2 LI M. AND. I NRCTR. LT . NI NNER ( MA JCTR ) ) 
1 ) GO TO 240 

IF ! MA JCTR. LT. MAXI T .AND. ORE FIN) GO TO 210 
2511 IF! ES2MX.LT. (CLEN*T0LES2 ) .OR. 1 NRC T R. Gt . N I NNER! MA JCT R ) ) GO TO 300 


GE 205 


GE 210 


C CALCULATE POINT MOVEMENT (LRLl AX) Gt 240 

2 AO LOVtR = A 

CALL OVERLAY! 3HSTC, 4,0) 

I F ( ERR I GO TO 15 

C ADJUST STREAMLINES, CALCULATE FAR FIELD VELOCITY DISTRIBUTION 250 
250 LENTRY= 4 
LOVER = 3 

CALL OVERLAY! 3HSTC , 3 ,0 ,6HRtC ALL ) 


3 



IF(ERR) GO TO 15 
I NRC 1 R= INRCTR+1 
GO TO 215 

C WRITE OUTPUT 
300 LENTRY* 2 
LOVER * 2 

CALL OVERLAY! 3HSTC, 2,0,6 HKEC ALL ) 

IF ( PDUM( 10) .E0.2. ) CALL E DUMPS 

IF(ERR) GO TO 15 

IF ( END JOB ) GO TO 100 

I F ( IN3.E0. ITRUE ) T AP IN = . TRUE . 

I F ( IN4.EQ. ITRUE ) T APOT = .TRUf . 

I PRO GM = IN2 
GO TO 11 
C 

100 WRITE (6,2000) 

2000 FORMAT ( IH 1 // 10 X , 26H ** ****** * ENOJOB *«■*****♦*) 
STOP 
END 



♦DECK USECDG 
BLOCK 

♦USECDG 

COMMON 

COMMON 

COMMON 

COMMON 

COMMON 

COMMON 

COMMON 

COMMON 

COMMON 

COMMON 

COMMON 

COMMON 

COMMON 

COMMON 

COMMON 

COMMON 

COMMON 

COMMON 

COMMON 

COMMON 

COMMON 

COMMON 

END 


DATA USECDG 

REPLACE LFIELO USE CARDS 


/ALLCOM/ 

Cl(24) 

/CPRINT/ 

C32<26) 

/CTHICK/ 

C7( 120) 

/CIDEX 

/ 

C 5 ( 6 ) 

/CFRFIN/ 

C3(6) 

/CBEAM2/ 

C 30( 20 ) 

/CDS2 

/ 

C 1 2( 900) 

/CRHS 

/ 

RHS( 768) 

/CHDATA/ 

C9 ( 2200) 

/CEND 

/ 

C 2 ( 2 ) 

/CCURV 

/ 

CURV ( 768 ) 

/CPHll 

/ 

PHIK768) 

/CS1 

/ 

SI (768) 

/CS2 

/ 

S21768) 

/SLTAB 

/ 

C 8 ( 384 ) 

/CM 

/ 

JMS( 768) 

/CB 

/ 

8(768) 

/Cl 

/ 

Z( 768) 

/CR 

/ 

R ( 768 ) 

/CVM 

/ 

VM ( 768 ) 

/CFRFLD/ 

C4 ( 8 30 ) 

/ERASE2/ 

C31( 1536) 
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♦ DECK 


STCBLK 

block oata 


STCBLK 


♦STCBLK 


STC BLOCK OATA 


-STCBLK- 


DIMENSION 
EQUIVALENCE 
COMMON /CBEND 


/CBITS 
/CCUBE 
/CGRAV 
/CPI 
/CPRINT/ 
/BENDIN/ 
/CBOW / 


COMMON /ALLCOM/ MACHA , PS A , TSA ,P TA , TT A , AX I A,RGA, GAMA, 

1 MACHC»PSC»TSC»PTC,TTC» AX I C ,RGC, GAMC , 

2 DAXIT»SCALEA»TTE»CHOTST 

REAL MACHAUI.MACHC 

LOGICAL AXIAfAXIC ,CHQTST 

TABLE OF INDEX LIMITS 

COMMON /IXORIG/ LHO.LHE, LBDO.LBDE, LTO» LTE , LWO,LWE, LFO*LFE « 

♦ LO» LESTA , LDUM ( 8 ) , 

♦ MO » NM » N J ,NFCOLS» MAXNJ.MAXOL* MAXNM, MAXLE , 

♦ LEO, LEE, LRO,LRE , LRD 

L I M I T S t 2 ^ ) 

(LIMI FS.LHO) 

NBCR ( 2 ) , ANGE ( 2 ) ,CURVE (21 «FB(2 ) 

81 TS, BLANK 

NBC ( 2 ) ,C 1 ( 2 ) ,C2 (2) ,FEND<2) 

CG 

PI ,TWOPI ,PIQ2,PI 04 « TODEG • TOR AD 
PP K ( 26 ) 

NBC I N ( 2 ) * ACF ( 2 ) 

BS HOCK, DUMB SIB) 

B SHOCK 

/ CRXSL, CRX OL,CRXSS»CRXE »CRXC *CRMACH 
CRX( 6) 

( CRX » CRXSL ) 

SL EXTENSION CRITERIA 
= NEW OL EXTENSION CRITERIA 
= EXTENSION CRITERIA FOR NEW OL 
= EXTENSION CRITERIA FOR NEW OL 
= EXTENSION CRITERIA FOR NEW OL 
/CFB2 / PASS1 
P ASS 1 

INRCTR, ROOM, N INNER (16) ,CNVF(16) 

FARFLD { 2 I ,FRE E ( 2 ) , PRES ( 2 ) » RFF , NZ P , 
ZP(10),PPS(IJ), A I , A2 1 ADUMI 6 ) 

FARFLD f FREEfPRES 
R HOB AS fRHQAMPflADM 

LBL* L S S ( 2 ) ,LBLCTR,MAXLBL,T0LLBL,ES2LBL»SS0L 
LBL , SSOL 

LINEStOMITFK»PTITLE(6) 

RHL » RM, AHL , ARM 


COMMON 
COMMON 
COMMON 
COMMON 
COMMON 
COMMON 
COMMON 
LOGICAL 
COMMON /CCRX 
DIMENSION 
EQUIVALENCE 
CRXSL = NEW 
CRXOL 
CRX SS 
CRXE 
CRXC 
COMMON 
LOGICAL 

COMMON /CINNER/ 
COMMON /CISBOT/ 
l 

INTEGER 

COMMON /CIADIN/ 
COMMON /CLBL / 
LOGICAL 

COMMON /CLINES/ 
COMMON / CNORM , 


IN REGION WITH SOME 
WHICH CROSSES SONIC 
WHICH CROSSES SHOCK 


SS-FLOW 

LINE 

WAVE 


COMMON /CPRPRN/ 
INTEGER 

COMMON /CPTMOV/ 
LOGICAL 

COMMON /CREFIN/ 

I 

DIMENSION 
EQUIVALENCE 
COMMON /CSS / 


1 


INTEGER 
LOGICAL 
SSFML * 
SSEF = 


PRPRN 
PRPRN 

VELPOT » I COB » NODE NS »C PTDUM 
VELPOT 

SL S, SG2I « VMG I » VMG2 , NGR, NGZ» SGR( 10) ,GR( 10 ) , 
SGZ ( 10 ) , GZ ( 10 ) 

GAO(AO) 

( GAO , SGR ) 

SSFML, SSEF, SSEANG, SSDF ,SSFEND»SSFND1 
,SSDLE,A4FACT,BRLX,CURRLX,TSIC,RH0C,RH0CSS 
SSFML 

SSEF, SSDF, SSDLE 

SUPERSONIC CURVATURE FORMULA NUMBER 
SUPERSONIC ENTERING FLOW, T OR F 
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S$EANG= ENTERING FLOW ANGLE (DEGREES) FOR SSEF=T 
SSDF = SUPERSONIC DISCHARGE FLOW, T OR F 

SSFEND= SUPERSONIC BEAM DOWNSTREAM END CONDITION, =0,1 FOR PARABOL 

SSFNOl= SUPERSONIC BEAM UPSTREAM ENO CONDITION, =0,1, FOR PARABOLA 

SSDLfc * SS FLOW BELOW AND AFT OF LE PT, T OR F 

A4FACT= CENTRAL POINT INFLUENCE COEFFICIENT FACTOR 

BRLX = 8-RELAXATION FACTOR 

CURRL X= CURVATURE RELAXATION FACTOR 

COMMON /CSLC / BRANCH(4) 

COMMON /CTOLRL/ TOLRL , MA XSWP , CLEN, 0S2MX, T0LES2 ,NSWP, 

1 DS 1DMP » D S iMX A , DS 1MXB , DS1RMS, ES2MX , DS1RM0 

*, SGlMINf TOLINR 

COMMON /SLTAB2/ PTR<128» 

COMMON /L INMAX/ LMAX 


DATA MACHA/1.E+15/,PSA,PTa/2*14.696/,TSA,TTA/2*518.7/, 

1 RGA/1716.2/, GAMA/1. A/, AXIA/.TRUE./ 

DATA CHOTST/.TRUE./, SCALEA/1./, TTE/O./ 

DATA NBC IN/2t 2/ 

DATA LHOtLHE/1,0/ 

DATA LEO, LEE/1,0/, LRO , LRE / I , 0/ ,M0 ,NM/ l , 0/ 

DATA MAXNJ/128/, MAXOL/96/, NFCOLS/20/ 

DATA BlTS/1. E + 15/, BLANK/ 1H / 

DATA P I /3 • 1 A 159265/ , TWOP I /6 . 28 31 853 / , PI02/1 .57079632/ , 

1 PIQA/. 78539816/, TODEG/ 5 7. 2957795/ , TORAD/. 0174532925/ 

DATA CG/32.174/ 

DATA (PTlTLE( I),I=1,6)/6H ,6H STRE , 6HAMTUBE ,6H CURVA, 

* 6HTURE P,6HR0GRAM/ 

DATA PPK/26*0./ 

DATA BSHOCK/F/ 

DATA CRX/.375, .375, . 125,0.,0. ,0./ 

DATA NINNER/I6*10/,CNVF/16*1./ 

DATA (FARFLDl I ) , I = 1 , 2 ) / 1 OHFF ,10H / 

DATA (FREE( I ), I = 1 , 2 ) / 1 OH ,10H / 

DATA <PRES< I ),l=l,2)/10H ,10H / 

OATA Al,A2/2. ,8./ ,AOUM/. 25,5*0. / 

OATA RHOBAS , RHOAMP, I ADM/ .5, .5,0/ 

DATA PASS!/. TRUE./ 

DATA LBL/. FALSE./, MAXLBL/5/, TOLLBL/.Ol/ 

DATA RN/O./ 

DATA RHL/1./, RM/l./ 

DATA PRPRN/O/ 

OATA VELPOT/F/, ICOB/O/, NGDENS/O/ 

DATA G40/40*1.E*15/»NGR»NGZ/1,0/ 

DATA VMG1, VMG2/. 1 , . 1/, SGR/ 10. ,9*0. / , SLS,SG2i/ .01 , 1 ./ 

DATA SGZ / 10*0 . / 


OATA SSFML/1/, SSE F/ . F AL SE . / , SSEANG/O./t SSDF/. FALSE ./ 

1, SSFEND,SSFNDl/.75,. 75/ 

2, SSOLE/F/, A4FACT /. 3/ , BRLX ,CURRLX/1 . ,1./# TSIC/2./ 

3, RHOC , RHOCS S/ 1 • , 1 . / 

DATA BRANCH/40999./ 




DATA TOLRL/l.E-3/, MAXSWP/20U/ , T0LES2/1 . E-3/ 
OATA SG1MIN/10.E06/, I0LINR/.05/ 

DATA DS10MP/.02/, DSIRMO/O./ 

DATA PTR/ 128* 1 . / 

DATA LMAX/64/ 

DATA PSA,PTA,TSA, T TA , RGA /5*1 . / 

END 



♦DECK EDUMPS 

SUBROUTINE EDUMPS 
♦EDUMPS NORMAL TERM. EOUMP 

COMMON /CHDATA/ XIF(l) 

DIMENSION XI(l) 

EQUIVALENCE C X 1 F , X 1 ) 

COMMON /IXORIG/ L HO, LHC » LHDU ,L BDE , LTO.LTE, LWO,LWE, LFO,LFE. 

♦ LO,LI STA»LSO»LSE , LDUM( 6 ) , 

♦ MO.NM, N J *NF ClJLS * MA XN J , MA XOL , MA XNM » MAXLE » 

♦ LLO.LEEt LRU.LREtLRD 

DIMENSION LIMITS(2A) 

EQUIVALENCE (LIMITS, LHO) 

COMMON /CTABPR/ I 1TAB 
I1TAB = LFO 

CALL TABPRTt 6HCADJWF ,X1F ,LFE , 8) 

ILTAB = LO 

CALL TARPRT(6HSTATAB,Xl,LESTA,5) 

RETURN 

END 
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♦ DECK ERRORK 

SUBROUTINE ERRORK ( NAME J 

COMMON /ALICOM/ M ACHA , PS A , TSA , PT A , TT A, 


1 

2 

REAL 

LOGICAL 

LOGICAL 

COMMON /ERASE2/ 

1 

2 

2 

REAL 

DIMENSION 
EQUI VALENCE 
DIMENSION 
EQUIVALENCE 
FIELD TABLES 
INDEX- M=MO»NM 


COMMON 

COMMON 

COMMON 

COMMON 

COMMON 

COMMON 

COMMON 


/Cl 

/CR 

/C$2 

/CS1 

/CPHII 

/CM 

/CCURV 


AXI A» RGA» GAMA* 

MACHC#PSC t TSC .PTC, TTC, AXIC.RGC.GAMC. 

DAXI T . SCALEA. TTE .CHOTST 
M ACHA ( 1 ) , MACHC 
AXIA.AXIC 
CHOTST 

AREA (96) .ARE AO( 96 ) ,DISP(96) * PT (96 )« LAMBDA ( 96 ) , 
RHO( 96), SQRTVV(96) * TS( 96 ) ,TT(96) ,VMSQ(96) , 
VVKQKP ( 96 ) , 

WQA( 96) , WSTA ( 96 ) . KG (96) ,C2CP (96 ) ,FGR(96) 
LAMBDA 

ES2( 96) , SDNQRMI 96) 

(ES2, VVKQKP), (SDNQRM.RHO) 

RCU( 96) 

( RCU, LAMBDA) 


Z ( 300 ) 

R( 300) 
S21300) 

S 1 ( 300 ) 
PHIK300) 
JMS( 300) 
CURV ( 300 ) 


COMMON /CB / 8(300) 

COMMON /CIDEX / M , J , MU ,MD , I ST AG 
TABLE OF INDEX LIMITS 

COMMON /IXORIG/ LHO.LHE, LBDU.LBDE, LTO.LTE, LWO.LWE. LFO.LFE . 

* initirTA i r\i iu i a \ 


DIMENSION 
EQUIVALENCE 
COMMON /CVM 


LO.LESTA, L DUM ( 8 ) . 

MO.NM, NJ.NFCOLS, MAXN J , MAXOL , MAX NM, M AXLE , 
LEO, LEE, LRO.LRE , LRD 
L IMI TS ( 2A ) 

(LIMITS, LHO) 

VM ( 300 ) 


STREAMLINE TABLE 

COMMON /SLTAB / W ( 12 8 ) , X 2 ( 128 ) , SLCHN ( 128 ) 

INTEGER SLCHN 
BOUNDARY TABLE 
INDEX- LB-LBDO, LBDE 

LBNEX T= INCREMENT TO NEXT BOUNDARY 

LBZ1 = INCREMENT TO THE FIRST BOUNDARY POINT (*0 BEFORE COALLATIO 
CHNAME= CHANNEL WITH WHICH THE BOUNDARY DATA IS ASSOCIATED 
UP * T OR F FOR UPPER OR LOWER BOUNDARY 

LEDEX - RELATIVE INDEX OF L.E. POINT WHEN LOWER AND UPPER SURFACE 
CONTOURS ARE CONNECTED 

BDNAME,LBA,LBB=NAME AND INDEX LIMITS OF SPECIFIC BOUNDARY 

DATA WHEN BOUNDARIES ARE COALLATED 
DIMENSION BDT( 1 ) ,L BNEXT ( i ) , LBZ 1 ( l ) , 

1 CHNAMEd ) ,UP( 1) ,LEDEX(1) , 

2 ZBT(1)»RBT(1) .ANGBT ( 42 ) 


LOGICAL UP 

INTEGER BDT .CHNAME , BDNAME 

DIMENSION BDNAME ( 1 ) .LB A ( l ) , LBB ( l ) 

EQUIVALENCE { BDNAME ♦ ZBT ) , (LBA.RBT). (LBB.ANGBT) 
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FLOW ADJUSTMENT TABLE 
INDEX- LF = L FO , L FE 
NFCOL S = 8 

X IF = ORTHOGONAL COORDINATE 

X2F = STREAMLINE COORDINATE OF SL EMINATING FROM T.E. 

X 1BF = X 1-COORDINATE OF CHOKE STATION OF FLOW BELOW T.E. 

XIAF = XL-COOROINATE OF CHOKE STATION OF FLOW ABOVE T.E. 

S1F = S 1 -COORO I NATE OF T.E. (UPPER SURFACE). THIS ITEM 
IS USED WHEN INTERPOLATING FOR WAKE DELTA-STAR. 
IFH,LFA=INDICES UF STATIONS ULLUW AND ABOVE T.E. 

NCHB,NCHA=NUMBER OF CHANNELS BELOW AND ABOVE T.E. 

LRF = INDEX OF DUMMY ORTCHN LIST FOR THE T.E. 

LRXF - INOEX OF LAST CHANNEL BELOW THE T.E. 

JORDER= 0 IF TOTAL FLOW AT X1F IS GIVEN 
= 2 IF FLOW ABOVE T.E. IS GIVEN 
= l IF FLOW BELOW T.E. IS GIVEN 
JORDER= -1 IF FLOW AT X1F IS CHOKED AND SINGLE CHANNEL 
DIMENSION X IF I 1 > ,X2F( 1) ,X1BF ID, XIAF ID • 

1 S IF I I ) »NC HB ( 1 ) » NCHAI 1 ) , J ORDER ( 1 ) , VNRI 12) 

EQUIVALENCE ( L FB , X IB F ) , ( LFA , X l AF ) , { LRF , NCHB) , I LRXFyNCHA ) 
DIMENSION LFBtD.LFAU) , LRF ID ,LRXF ( 1 ) 

STATION TABLE 
INDEX- L=LU,LESTA 

SCHOKE= STATION CHOKt INDICATOR ( AD J WF , BRHS , WR IOUT ) 

MCL = SHARP CORNER INDICATOR { BLDTBS ) 

MCL = FIELD INDEX OF CONTROL STREAMLINE I PTMOVE , FLOBAL ) 

common /chdata/ xki ) ,lnext < i )«mlb< l ) , mub( l ) »PRl m( i ) , 

I TYPE lb ( 1 ) fNAMELB(l) • I L B f 1 ) » FLB ( 1 ) tSILBIl) • 

1 TYPE UB ( 1 ) .NAMEUBU) .IUB(l) »FUB(1 ) » S1UBI 1 ) • 

3 VMB( D.OWUvm, X2CL ( 1 ) * VCL ( 1 ) »MCL ( 481 ) 

LOGICAL PRIM 

DIMENSION SCHOKE(l) 

EQUIVALENCE ( SCHOKE , D WOV ) 

EQUIVALENCE ( BDT, X1F , X 1 ) * (LBNE XT , X2F , LNEXT ) , ( LBZ1 * XI BF * MLB ) 

EQUIVALENCE ( CHNAME , X 1AF , MUB ) , ( UP t SiF , PRI M ) 

EQUIVALENCE (LEDEX,NCHB,TYPELB) , (ZBT,NCHA,NAMELB) 

EQUIVALENCE ( RBT , JQRD E R , I L B ) , i ANGBT * VNR »F LB) 

COMMON /CTABPR/ I 1 TAB 

WRITE (6,100) NAME 

100 FORMAT( //2X, 13HERR0RK CALL — ,1A6//) 

CALL TABPRT(6HALLC0M,MACHA,20,8) 

I1TAB = LB DO 

CALL TABPRT(6HBDYTAB,BDT ,LBDE ,3) 

I1TAB = LFO 

CALL TABPRT(6HCADJWF,XIF ,LFE ,B) 

I1TAB = LO 

CALL TABPRT(6HSTATAB,X1»LESTA»5) 

150 WRITE (6,1150) ( J , X2 ( J ) , SLCHN ( J ) * W ( J ) , J= 1 ,N J ) 

CALL JMSPRT 

CALL TABPRT(2HSI,S1,NM,10) 

CALL TABPRT ( 2HS2,S2, NM ,10) 

CALL TABPRT( 1HZ,Z,NM,10) 

CALL TABPRT ( 1HR,R,NM,10) 




CALL TABPRT< AHPHI 1 ,PH1 1,NM,10> 

CALL TAPPRT < 4HCUKV ,CUHV, NM, 101 
CALL FABPRT(2HVM,VM,NM,10) 

CALL F ABPRT ( 1 HB » B , NM , 1 0 ) 

CALL TABPRT(6HERASE2,AREA,1536, 8) 

160 WRITE (6,1160) NO 
1160 FORMAT ( ///AH NQ=,I4) 

CALL TA8PRT(2H20,2Q,N0,10) 

CALL TA8PRT ( 2HR0 , RQ, NQ , 1 0 ) 

CALL T ABPRT ( 5HCliRVQ,CURV0 »NQ » 10 ) 

CALL TABPRT(5HPHIIQ,PHUQ,NQ,10) 

CALL TABPRT ( 3HX2Q , X2Q,N0 , 10 ) 

CALL TABPRT ( 5HKCHNQ, KCHNQ , NO, 10) 

LS TOP =* 5 

IFILST0P.EQ.5) STOP 
RETURN 

1150 FORMAT (///IX17HSTREAMLINE TABLE -/ l 7X 32HJ X2 

* W/( I 18,F12.6,6X,A6,F 12.6, ), ) 


SLCHN 



♦ DECK AT AN 3 

FUNCTION ATAN3(OY»OX,ANGREF) 

♦ATAN3- ARCTAN FUNCTION WITH REFERENCE ANGLE -ATAN3- 

C LIMITS ARE- (-PI) .LE. ( ATAN3-ANGREF > .LT. l*PI) 

COMMON /CATAN3/ DANG 
COMMON /CPI / PUTWOPI 
DATA KNAME/6HATAN3 / 

ANG = A I AN2 ( DY , DX ) 

N =20 

SO N = N-l 

IF(N.LO.O) CALL I KKOKK ( K NAME ) 

DANG = ANG-ANGIUI 
IMP l -DANG) SO, 70, 70 
60 ANG = ANG-TWOPI 
GO 10 50 

70 I F ( DANG+P I ) 80,90,90 
80 ANG = ANG+TWOPI 
GO TO 50 
90 ATAN3 = ANG 
RETURN 
END 




ooooooooo o o n 


♦DECK BARC 

SUBROUTINE BARC ( I ) 

♦8ARC-- BOUNDARY INTERVAL CURVAllNEAR DIST -BARC” 

INPUT- 

BDY * BOUNOARY TABLE OF Z «R ,ANG 

I = INDEX OF COOR-Z RELATIVE TO BDY-TABLE ORIGIN 

OUTPUT- 

DR * DELTA-R = R( IV + D-RIIV) 

DZ = DELTA-Z = Z( I V + l )-Z I I V) 

dx * Chord connecting the points of the interval 
angchd* angle of the chord 

YPA = ANGLE RELATIVE TO THE CHORD, POINT-1V 

YPB = ANGLE RELATIVE TO THE CHORD, POINT-IV+1 

S I NTVL * CURVALINEAR DISTANCE BETWEEN POINTS IV,IV*l 
( ALSO- YPASQ, YPB SQ,YPAB) 

C BOUNDARY TABLE 
C INDEX- LB=LBDO, LBDE 

C LBNEXT = INCREMENT TO NEXT BOUNDARY 

C LBZ1 = INCREMENT TO THE FIRST BOUNDARY POINT 1*0 BEFORE COALLATIO 

C CHNAME* CHANNEL WITH WHICH THE BOUNDARY DATA IS ASSOCIATED 

C UP = T OR F FOR UPPER OR LOWER BOUNDARY 

C LEDEX * RELATIVE INDEX OF L.E. POINT WHEN LOWER AND UPPER SURFACE 

C CONTOURS ARE CONNECTED 

C BDNAME, LBA,LBB=NAME AND INOEX LIMITS OF SPECIFIC BOUNOARY 

C DATA WHEN BOUNDARIES ARE COALLATED 

COMMON /CHDATA/ BDT (I) , LBNE X T (i) , LBZ 1 ( 1) , 

1 CHNAME (I I , UP ( i) ,LEDEX(l), 

2 ZBT( l),RBT(i) ,ANGBT ( 42 ) 

LOGICAL UP 

INTEGER BDT, CHNAME, BDNAME 

DIMENSION BDNAME (1 ) ,LBA I i I , LBB ( I ) 

EQUIVALENCE ( BDNAME , ZBT ) , (LBA.RBT), ( LBB • ANGBT ) 

COMMON /CBEAM2/ DR ,DZ , YP A , YPB ,F ,G , DX , YQDX , ZM , RM « ANGM ,CURVM, S LM , 
l RZONLY, ANGCHD, SINTVL, YPASQ, YPAB,YPBSQ 

LOGICAL RZONLY 

DZ = ZBT ( I+3)-ZBT( I ) 

DR = RBT ( 1+5 )-RBT ( I ) 

DX = SORT ( DZ*DZ+DR*DR ) 

IF( DX .EQ.O. ) GO TO 90 
ANGCHD* AT AN 31 DR, DZ, ANGB Til)) 

YPA * ANGBT ( I I-ANGCHD 
YPB = ANGBT ( I +3 ) -ANGCHD 
YPASQ => YP A*YP A 
YPAB * YPA«YPB 
YPBSQ * YPB*YPB 

90 SINTVL* DX* I 1 . ♦ ( YPASQ- . 5*YPAB + YPBSQI /i5 . ) 

RETURN 

END 

\°< 
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♦ DECK 

♦ BEAM 
C 


BEAM 

SUBROUTINE BE AM ( X , Y, ANG , N ) 

ROTATED CUBICS SIMILATING A BEAM -BEAM- 

FIT TO COORDINATE POINTS 

DIMENSION X( 100) , Y< 100),ANG( 100) 

INPUT- 

X,Y = COORDINATES OF POINTS 

ANG = ESTIMATED ANGLE AT THE GIVEN POINTS, RADIANS (MA*1) 

ANG ( I i = ESTIMATED ANGLE AT THE FIRST POINT (MA=0) 

N = NUMBER OF POINTS 

MA = 0 IF THE VALUES OF ANGLES ARE NOT ESTIMATED. 

= l IF ESTIMATED ANGLES ARE GIVEN 
MB = NO OF ITERAT IONS 

KD = STORAGE INCREMENT OF X .Y .ANG 

KORDER= 0 IF ERROR 1 IS TO BE CALLED WHEN PTS ARE OUT OF ORDER 
= -1 TO SKIP THE POINT ORDER CHECK 

= .GE.l IF RETURN IS TO BE MADE FOR CORRECTIVE ACTION 
(IF NOT INPUT M A = 0 » MB = 1 , Kf> = 1 , AND K0RDER=0) 

SUBROUTINE BEND MUST BE PROVIDED TO CALCULATE THE FOLLOWING COEFFI 
AI«?,1),A(3,1).B(1)» All * N ) ,A(2»N),B(N) 

OUTPUT- 

ANG = CALCULATED VALUE OF THE CURVE ANGLE, RADIANS 

B = SLOPE IN ROTATED COORDINATES, LEFT END OF SEGMENT 

YPB = SLOPE IN ROTATED COORDINATES, RIGHT END OF SEGMENT 

ACHD = ANGLE (RELATIVE TQ HORIZONTAL) OF THE LINE SEGMENTS, RADIA 

CHD * LENGTHS OF THE LINE SEGMENTS BETWEEN THE INPUT POINTS, CHO 
KORDE R= INDEX OF 2ND OF ADJACENT OUT-OF-ORDER PTS, N0T=0 ON ENTRY 

NOTE-COMMON /ERASE/ MUST BE 8*N IN LENGTH. ITS LENGTH MAY BE CHANG 
BY A $USE CARD WITHOUT PROGRM RECOMPILATION. 

ORDER OF STORAGE IN COMMON /ERASE/ IS - A ( 1 , 3 ) , All , 1 ) , A ( l , 2 ) , B < 1 ) , 
YPB< i ) ,DA( I ) ,ACHD( 1 ) , CHD ( I ) , A(2,i),A(2,2 ) , A ( 2, 3 ) , B ( 2 ) , YPB ( 2 ) , DA ( 


COMMON /CAT AN 3/ 
COMMON /CREAM / 
COMMON /ERASE / 
DIMENSION 
EQUIVALENCE 


DANG 


MA,MB,KO 

At 3) ,Bll ) , YPH ( 1 ) ,DA ( 1 ) , ACHD ( 1 ) ,C HD ( 793 ) 
YPA( 100) 

( YPA.B ) 


IF(N.LE.l) CALL LRROR 1 
M = MA 

N8 = 8*N-7 


CALCULATE THE CHORDS CONNECTING THE GIVEN POINTS 

AND CALC THE TURNING ANGLES BETWEEN SUCCESSIVE CHORDS 
K = 1 

I = 1 

IM8 = 1 

ACHD( i )=ANG( 1 ) 

KP = K-fKD 

SX = X(KP)-XIK) 

SY = Y ( K P ) — Y ( K ) 

B( I ) = ANG ( K ) 

CHD ( I ) = SORT! SX^SX + SY^SY ) 



100 



ACHOI I )*ATAN3< SY, SX.ACHDI IM8) ) 

DA( I > =» DANG 

IFII.GT.9 .AND. (A8S(DA( l))+ABS(DA(IM8)l).GT.PI .AND. 

* KORDER .NE . I — 1 J ) GO TO 800 
130 JM8 * I 
I *1*8 

K = K+KD 

IFII-N8) 100, 140.140 
140 ACHD< I )=ACHD( 1-8) 

DA ( 1 ) = 0. 

8(1) = ANG ( K ) 

C SLOPES IN THE ROTATED COORDINATE SYSTEM 

C FROM THE ESTIMATED INPUT ANGLES 

I * 1 
!F(M) 160,180,160 
160 YPAII)* TANIB1I )-ACHD( I ) ) 

Y PB ( I ) = TANI BI 1+8 >-ACHD( l ) ) 

I =1+8 

IF(I-NB) 160,200,200 

C SLOPES EQUAL TO A FRACTION OF THE LINE SEGMENT TURNING 

180 YP A ( 1 ) = - • 2*DA I 9 ) 

1 * 9 

185 YPBI 1-8 )=.4*DA( I ) 

YPAI I )= -YPBI 1-8) 

I =1+8 

IFII-N8) 185,190,190 
190 YPBI 1—8 )=.2*DAl 1-8) 

C END EQUATIONS 

200 CALL BENDIN) 

C MATCHING ANGLE AND CURVATURE EQUATIONS 

1FIN-2) 250,300,250 
250 I - 9 

GO TO 260 

255 AID » CHOI I )*( l. + l.5*YPA(l )*YPAII) ) 

A I 1+2)* CHOI 1-8)* I 1.+ 1.5* YPBI 1-8)* YPBI 1-8) ) 

A I I+l )* 2 . * I A I I ) +A 1 1 +2 ) ) 

BII) = -2.*AI I )*DA I I ) - AI 1 + 2)* DA (1+8) 

I =1+8 

260 IFII-N8) 255,300,300 

C ROUTINE TDSEQ - TRIDIAGONAL SIMULTANEOUS EQUATIONS 

C SOLUTION TO AX=B. ON RETURN SOLUTION VECTOR X IS STORED IN B 

300 AI 3 I = A13J/AI2) 

BID = BI 1 )/A< 2) 

I * 9 

C SPECIAL LOGIC FOR A(l,3) 

All) = AI D/At 2) 

A I 10 ) = AI 10 )-A I 9 )* A I 3 ) 

A I 1 1 ) = I A I 1 1 )- A I 9 ) *A ( 1 ) )/Af 10) 

GO TO 312 

310 A( I + 1 ) 3 AII + D-Al I )*AI 1-6) 

AI 1+2)* AI I +2 ) / A ( 1+1) 

312 BII) = (BI I )-A( I )*B( 1-8 ) ) / AII+l) 

I =1+8 




c 


c 


- c 


IF ( I-N8 ) 310, 320,340 

SPECIAL LOGIC FOP A(N,N-2) 
320 A ( I ) = AI I ) -A I I+2)*AI 1-14) 

till) = B( I ) — A I 1 + 2) *B! 1-16) 
GO TO 310 
BACK SUBSTITUTION 
340 1 = NB 

350 I = I-B 

IF! 1-1) 400,355,360 

SPECIAL LOGIC FOR A( 1,1 ) 

355 (3( 1 ) = 13 ( 1 )-A( 1 )*B ( 17) 

360 B( I ) = 13 ( I)-A( l+2)*H( I ♦ B I 

GO T(J 3 50 


C REEVALUATE YPB 
400 I =9 

405 YPB ( 1-0)= ti ( I )+DA( I) 

I = 1+8 

I F ( I-N8 ) 405,405,450 

C RETURN FOR ANOTHER ITERATION 

450 M = M + l 

IF(M-MB) 200,200,500 

C ANGLES 

500 I = 1 

K = 1 

505 ANG ( K ) = ACHD( I ) +ATAN I B ( I ) ) 

I =1+8 

K = K+KD 

IF ( I-N8)505,505,5)0 
5 30 KORUb K = 0 
GO TO 900 

C ERRUR - OUT 01 ORDER POINTS 

800 I F ( KOKDER . EO . 0 ) CALL ERRUR1 
KORDE R= !•: 

900 RETURN 
END 


17 



♦DECK CBEAM 

RLOCK DATA BfcAMBK 

♦CBEAM- DATA FOR /CBEAM / -CBEAM- 

CUMMON /CBEAM / MA ,MH , KD » KORDER 
DATA MA f MB,KD,K0R0ER/0,l , 1,0/ 

END 



on o on o o on ooooooooon 


♦DECK BEND 

SUBROUTINE BEND(NN) 

♦BEND— END CONDITIONS FOR THE BEAM FIT -BEND- 

ON ENTRY - 

N = NUMBER OF POINTS 

ALSO in FINED ON ENTRY - IN COMMON/CREND/ - 
NBC ( L ) = BOUNDARY CONDITION INDICATOR FOR LEFTtL*!) ANO RIGHTIL-21 

= U . 1 , OR 2 

ANGfc ( L ) = ANGL F IN DEGREES IF NBC(L) = l 
CURVE (L )=CURVATURE IF NBC(L)=2 

FEND(L)= RATIO OF SHEAR OF THE END TO NEXT TO END INTERVAL, NBC l L ) 
ON RETURN- 

COEFFICIENTS - A(2)»A(3),B(1) AND A ( N8 ) , A ( N8+I ) ,B( N8 ) 

COMMON /CBENO / NBC ( 2 ) , ANGE ( 2 ) , CUR VE I 2 ) ,FEND ( 2 1 
COMMON /CPI / P I tTWOPI ,PIQ2»PIQ4,T0DEG»T0RAD 
COMMON /ERASE / A ( 3 ) , B (1) , YPB ( I ) , DA ( 1 ) , ACHD (I) ,CHD ( 793 I 

INITIALIZE 
N = NN 

N8 = INDEX FOR RIGHT END POINT 
NB = 8*N-7 
A { 1 ) =0. 

A ( 2 ) =1. 

A( 3) =0. 

A I N 8 ) = 0. 

A(N8+li=l. 

A(N8 + 2 )=0. 

A STRAIGHT LINE IS USED FOR N = 2 IF NBC 1 1 ) =NBC ( 2) =0 
NBC S = NBC ( I M-NBC (2) 

IFCN.GT.2 .OR. NBCS.GT.O) GO TO 80 

B ( 1 ) =0. 

B( 2 ) =0. 

GO TO 900 

CHECK IF PARABOLA (F=0) SHOULD BE USED 
80 IFIN.E0.3 .AND. NBCS.EQ.O) GO TO 90 
FI = FEND ( 1 ) 

F 2 = FEND12) 

GO TO 110 
90 FI =0. 

F 2 = 0. 

NBC=0 I , Y AND ANGLE SPECIFIED 
LEFT END 

110 I F ( NBC ( 1 ) . NE . 0 1 ) GO TO 120 

B ( 1 ) = TAN(T0RAD*ANGE(1 )-ACHD( I) ) 

RIGHT END 

120 I F ( NBC ( 2 ) *NE .01 ) GO TO 210 

B{ N8 ) = TAN l TOR AD* ANGE ( 2 ) -AC HD I N8 ) ) 

NBC = 02 , Y AND CURVATURE SPECIFIED 
LEFT END 

210 IFINBCIII .NE.02) GO TU 220 
A { 2 ) = A. 




o o 


A( 3) = 2. 

H(l) = -2.*0A(9»+CHD( 1)*CURVE( 1 > * C 1 . + 1 . 5 *8 < 1 ) *B < 1 >> 

C MIGHT END 

220 IF(NBC(2).NE.02) GO TO 310 
A ( N8 J = 2. 

A( N8+ 1 > =4 . 

B(N8) = -CH0(N8-8>*CURVE(2)*(i.*l.5*YPB<N8-8)*YPB{N8-8>) 

NBC a O» YPPP = F * YPPPiOF ADJACENT INTERVAL) 

LEFT END 

310 IF(NBCm.NE.O) GO To 320 
IFIN.EQ.2) GO TO 315 
DX1SQ * CHD ( 1 ) *CHD ( 1 ) 

DX2SQ * CHDt 9 ) *ChO ( 9 ) 

A (2) = DX2SQ 

A( 1) * -F i*DX ISO 

A ( 3 ) = A ( 2 ) + A ( 1) 

B(l) = FI* DA (171*0X1 SQ - DA(9)*DX2S0 
GO TO 320 
315 A ( 3 ) = 1. 

B ( 1 ) =0. 

C RIGHT END 

320 IF(NBC(2).NE.O) GO TO 900 
IF(N.EQ.2) GO TO 325 
DXNSO = CHD ( N 8 — 8 ) *CHD ( N8-8 ) 

DXMSQ = CHD (N8-l6)*CHD(N8-16) 

A( N8+ 2 ) =-F2*DXNSQ 

A ( N8* 1 ) =DXMSQ 

A(N8) = A(N8+l)+A(N8+2) 

B(N8) = F2*DA(N8-8)*DXNSQ 
GO TO 900 
325 A ( N8 ) = 1. 

B(N8) * 0. 

900 RETURN 
END 





♦DECK CBEND 

BLOCK DATA BENDBK 
♦CBEND- DATA FOR /CBEND / 

COMMON /CBEND / NBC ( 2 ) , ANGE l 2 ) , CUR VE ( 2 ) • FEND ( 2 ) 
DATA NBC » AN GE » CUR VE» FEND/ 2*0 » 6*0. / 

END 


-CBEND- 



oo nnooooon nonooooo 


♦DECK BFI 

SUBROUTINE BFI 

♦BFI BEAM FIT INTERPOLATION -BFI - 

INPUT- 

OR = R( I + I )-R( I) 

OZ = zimi-2in 

YPA * ANGLE RELATIVE TO THE CHORDt POINT-I 

YPB = ANGLE RELATIVE TO THE CHORO, POINT-I+1 

F = X/OX 

G = (DX-XJ/DX 

RZONLY® T IF YODX, RM AND ZM ONLY ARE TO BE COMPUTED 

OUTPUT DATA AT THE INTERMEDIATE POINT WITHIN THE INTERVAL 
YQDX = Y/DX, DISTANCE NORMAL TO THE CHORD 
ZM = Z-Z ( I ) 

RM = R-R ( I ) 

DX = LENGTH OF THE CHORD 
ANGM = ANG-ANGCHD 
CURVM = CURVATURE 

SIM = CURVAL INEAR DISTANCE FROM POINT-1 
NOTES- 

CHORD = LINE BETWEEN POINTS I AND I+l 

COMMON /CBEAM2/ DR*DZ#YPA»YPB*F»Gt DX , YQDX . ZM v RM , ANGM, CURVM t S 1M* 
I RZONLY 

LOGICAL RZONLY 

DOUBLE PRECISION C 1 . C2 tC 3 » CA tC5 

YQOX * F*G* ( G*YP A-F^ YPB I 
RM = YQDX*D;*F+OR 

;m ^ F*nz-vgnxto« 

triH/DNlYI uU »n •i’iU 
DX * SORT ( DR*DR-»UZ*DZ ) 

ANGM = YPAA( 3.AG-2. )*G ♦ YPti* ( 3. *F~2» I *F 

CURVM = ( YPAM6.^G-2. )+YPB*(-6.»F + 2. ))/(DXMl.*1.5*ANGM^ANGMM 
YPASO = YPA^YPA 
YPAB = YPA*YPB 
YPBSO = YPB*YPB 
Cl * 1 • + . 5*YPASQ 
C2 = -2 •♦YPASO - YPAB 

C3 = ( 11. *1 YPASQ+YPAB ) ♦ YPBSQ+YPBSQ) /3 . 

C A = -3.+YPASQ - A . 5* YPAB - l.5*YPBSQ 

C5 * 9.*(YPASQ+YPAB+YPAB+YPBSQ) /10. 

SIM * DX*(F*(Cl-»-F*(C2+F*{C3+F*(CA+F*C5) I ) ) ) 

990 RETURN 
END 




♦DECK CBEI 

BLOCK OATA BFIBLK 

*CBF I — BLOCK OATA FOR BFI -CBFI- 

COMMON /CBEAM2/ DR ,DZ t YPA »YPB ,F ,G. DX*YQDX,ZM,RM, ANGM,CURVM,S1M, 
1 RZONLY 

LOGICAL KZONLY 

DATA RZONLY/. FALSE./ 

ENO 




♦DECK FHFAD 

SUBROUTINE F HE AD (LAI) 

CF HE AD CDC VERSION 

COMMON / ADAMO I / NAME ( 6 ) , ADORE S ( 6 ) , T I TIE ( 6 ) * IOENT ( 6 ) 
COMMON /CLINES/ L I NE S , OM I TFK , PT I TLE ( 6 ) 

COMMON /L INMAX/ LMAX 

LA = LAI 

C ADJUST LINE COUNT 

5 LINTOT* LINES+LA 

I F ( L INTOT.GT .LMAX ) GO TO 8 
LINES * LINTOT 

6 RETURN 

C RESTORE AND PRINT IDENTIFICATION IF LINE COUNT ,GT. LMAX 

b WRITE (6,810) TITLE, PTITLE.IDENT 
LINES = LA+3 
GO TO 6 

810 FORMAT ( IH I , 6A 10 , 33X, 6A6/ 1 X , 6A 10 ) 

END 



DECK GETIX 
I DENT GETIX 
ENTRY GETIX, SAVIX 
SUBROUTINE GETIX 


COMMON 
COMMON 
INPUT- 
J MS 
M 

OUTPUT- 

J 

MU 

MO 


/CM / JMSI300) 

/CIDEX / M , J ,MU, MD»ISTAG 

= ARRAY CONTAINING PACKED INOICES J,MU,MO» ISTAG 
= INDEX OF -JMS- ARRAY 

= STREAMLINE NUMBER 
= M- UPSTREAM 
= M- DOWNSTREAM 

ETC. 


♦ 

* 

ISTAG = 

INDICATOR FOR 

, STAGNATION POINT 

GETIX 

BSSZ 

I 



S A 1 

M 

CONTENTS OF M IN 


SA2 

X 1 + JMS- L 

JMS(M) IN X2 


SB3 

0 

INITIALI ZE 


SBA 

3 


LOOPG 

S A3 

MASK 1+B3 

LOAD MASK 


BX6 

X2*X3 

AND TO MASK 


S A 1 

SHIFT+B3 

SHIFT BITS IN XI 


S85 

XI 

MOVE TO B5 


AX6 

X6,B5 

SHIFT 


SA6 

J *B3 

STORE 


SB3 

B 3* I 



Lb 

B3, BA, LOOPG 


A 

JP 

GETIX 

TRA FUR RETURN 

* 

SUBKUUT I 

NL SAVIX 


* 

INPUT- 



* 

M 

INDEX OF JMS 

ARRAY 

* 

J 

STREAMLINE NUMBER 

* 

MU 

M- UPSTREAM 


* 

MO = 

M- DOWNSTREAM 

* 

ISTAG = 

INDICATOR FOR STAGNATION POINT 

* 

OUTPUT- 



* 

* 

J MS ( M ) = 

PACKED J,MU,MD, ISTAG 

SAVIX 

BSSZ 

1 



MX 3 

0 



SB3 

0 

INITIALI ZE 


S BA 

3 


LOOPS 

SA2 

B3 + J 

J IN X2 


SA1 

SHIF MB 3 



SB5 

XI 



LX2 

X2,B«i 

SHIFT LEFT 


H X 3 

X 3*X2 

UR TO X3 


SB 3 

B 3 ♦ l 



Lb 

B3, BA, LOOPS 



S A I 

M 



DX6 

X 3 

MOVE TO X6 


SA6 

Xl+JMS-I 

STORE JMS(M) 


JP 

SAVIX 

TRA FOR RETURN 

MASK. 1 

DATA 

000000000776000000000 


DATA 

000000000001777700000 


data 

00000000000000007 777 A 


XI 


ETC 



SHIFT 


JMS 

M 

J 

MU 

MD 

ISTAG 


data 

000000000000000000003 

DATA 

28 

DATA 

15 

DATA 

2 

DATA 

0 

USE 

/CM/ 

BSS 

300 

USE 

/C IDE X/ 

BSS 

I 

8SS 

1 

BSS 

1 

BSS 

1 

BSS 

END 

I 




♦DECK GETRLX 

I DENT GETRLX 
ENTRY GETRLX 

* 


(it T RLX 

LOUP 

L00P2 


UPO 


DNJ 


* 

UPPU 


* 

NO T PCJ 


BSSZ 

1 


SBA 

ZB 

I N 1 T I Al l ZL RL GI STERS 

SB 7 

- *> 


SB7 

B 7 ♦*> 

INDEX B7 

Gt 

B7»BA»G£TRL 

X 

SA1 

B7+M 

CONTENTS OF M IN XI 

SA2 

Xl+JMS-1 

JMS(M) IN X2 

SA3 

MASK1 

MU-MASK IN X3 

BX6 

X2*X 3 

EXTRACT MU 

S A 1 

SHIFT 


SB 3 

XI 

SHIFT BITS 

AX6 

X 6 » B 3 

SHIFT RIGHT 

NZ 

X 6 » U P 0 

TEST FOR STREAMLINE ORIGIN 

SAA 

M 

M- TO XA 

HX6 

XA 

MOVE TO X6 

SA6 

B7 + MU 

STORE CURRENT MU 

S A3 

MASK !♦ I 

MD-MASK IN X3 

DX6 

X2*X3 

EXTRACT MD 

S A 1 

SH I F T ♦ I 


SB 3 

XI 

SHIFT BITS 

AX6 

X 0 1 B 3 

SHIFT RIGHT 

NZ 

Xb t DNO 

T L ST EUR STREAMLINE TERMINATION 

SAA 

M 

M- TO XA 

BX6 

XA 

MOVE TO X6 

SA6 

B7+MD 

STORE CURRENT MD 

S A 3 

MASK 1*2 

I STAG-MASK IN X3 

BX6 

X2*X3 

extract istag 

SB6 

3 



.4 3 


X6 


MOVE LOW ORDER BITS TO B3 


UE 

B 3 t B6 1 NOT PO 

TEST FOR 

PARTIAL ORTHI 

7 K 

H 7 » NO 1 PO 

BRANCH IF MID-POINT 

Sb3 

5 



L U 

B 3 1 B 7 » UPPO 



SB3 

IS 



l 0 

B3,H7,UPPO 



SAA 

B7+MD 

CURRENT 

MD IN XA 

BX6 

XA 

MOVE TO 

X6 

SA6 

B 7 + M 

RESET M 

TO MOVE RIGHT 

JP 

LOOP2 



SAA 

H7+MU 

CURRENT 

MU IN XA 

BX 6 

XA 

MOVE 10 

X6 

SA6 

B 7 +M 

RESET M 

TO MOVE LEE T 

JP 

LOOP 2 



SB3 

15 



Gt 

B7 » B 3 ♦ LOOP 

CONTINUE 

IF ON EXTREMf 


NZ 

SAA 

14X6 

SA6 

SAA 

BX6 

SA6 


B7.TEST1 

MU 

XA 

M + 5 

MO 

X A 

M+iO 


POINTS 


CONTINUE check 
MU IN XA 
MOVE JU X6 
SET UP FOR M3 *M5 


•9 


MOVE TO X6 




JP 

LOOP 


TEST 1 

SH3 

5 



Nfc 

B7#B3» TEST*! 



SA4 

B7+MU 

SET UP M2 


BX6 

X4 

MOVE TU X6 


SA6 

M+15 



JP 

LOOP 


TEST2 

SA4 

B7+MD 

SET UP M6 


BX6 

X4 

MOVE TO X6 


SA6 

M + 20 



JP 

LOOP 


MASK L 

DATA 

OOOOOUOOOOU1 7 7 770 J000 


DATA 

OOOOOOOOOOUOUOOO 7 7774 


DATA 

OOOOOOOOOOOOOOOOOOOOJ 

SHIFT 

DATA 

lb 



DATA 

2 



USE 

/CM/ 


JMS 

BSS 

300 



USE 

/CIDEXR/ 


M 

BSS 

2 


MU 

BSS 

1 


MO 

BSS 

1 


ISTAG 

BSS 

21 



END 







♦DECK JMSPRT 

SUBROUTINE JMSPRT 

♦JMSPRT PRINT INDEX ARRAY, JMS -JMSPRT- 


COMMON /IXORIG/ LHO, LHE , LBDO »LBDE , LTO.LTE, LWO, LWE , LFOtLFE, 

♦ LO»LESTA , LDUMI8), 

♦ MO » NM , N J tNFCOLS t MAXN J.MAXOL.MAXNM, MAXLE, 

♦ LEO* LEE , LRO, LRE * LRD 

DIMLNSION LIMITS(24) 

EQUIVALENCE (LIMITS, LHO) 


COMMON /CIDEX / M , J , MU , MD , I S T AG 
COMMON /CM / JMS( 300) 

COMMON /ERASE / lour (BOO) 

C KESTOR PAGE 

WRITE (6,1000) 


M = 1 

IS =30 

40 I =1 

MA = M 

50 CALL GET I X 
i out ( i )=j 
I out ( I + 1 ) =MU 
IOUT( I +2 ) =MD 

I F ( ISTAG .EQ. 0) GO TO 60 
I OUT ( IS*l ) = M 
IOUT ( I S + 2 ) = ISTAG 
IS = IS ♦ 2 
60 I =1+3 

M = M* 1 

IFU.LT.30 .AND. M.LL.NMI GO TO 50 
IB = 1-1 

WRITE (6,1002) MA, ( IOUT( L ) ,L=1, IB) 
IF(M.LE.NM) GO To 40 
WRITE (6,1004) ( IOUT( I ), 1=31, IS ) 
1000 FORMAT ( 8HI J-MU-MD ) 

1002 FORMAT ( IX, 15,3014) 

1004 FORMAT ( /8H M- ISTAG/ ( 6X ,20 15 ) ) 
RETURN 
END 




oooooooooo 


-LBF- 


♦ UECK LEIF 

FUNCTION LBF ( BOYNAM J 

*LBF BOUNDARY TABLE INDEX FROM BDY NAME 


INTEGER BLANK, BDYNAM 
BOUNDARY TABLE 
INDEX- LB a LBDO,LBDE 
LBNEXT* INCREMENT TO NEXT BOUNDARY 

LBZ 1 = INCREMENT TO THE FIRST BOUNDARY POINT <»0 BEFORE COALLATIO 
CHNAME= CHANNEL WITH WHICH THE BOUNDARY DATA IS ASSOCIATED 
UP = T OR F FOR UPPER OR LOWER BOUNDARY 

LEDEX = RELATIVE INDEX OF L.E. POINT WHEN LOWER AND UPPER SURFACE 
CONTOURS ARE CONNECTED 

8DNAME »LBA,LBB=NAME AND INDEX LIMITS OF SPECIFIC BOUNDARY 

DATA WHEN BOUNDARIES ARE COALLATED 
COMMON /CHDATA/ BDT < 1 ) , L BNE X T(l ) , LB Z l I i ) , 

1 CHNAME (1 ) ,UP ( 1 ) ,LEDE X ( 1 ) , 

2 ZBTI 1),RBT(1)*ANGBT(42) 


* 

* 


LOGICAL UP 

INTEGER BDT, CHNAME, BDNAME 

DIMENSION BDNAME (l),LBA(i),LBB(l) 

EQUIVALENCE ( BDNAME , ZBT ) , ( LBA,RBT J , ( LBB , ANGBT ) 

COMMON /IXORIG/ LHO, LHE, LBDO ,LBDE * LTO, LTE , LWO,LWE, LFO.LFE, 

LO ,LE STA , LDUMI8), 

MO ,NM, NJ.NFCOLS, MAXNJ.MAXOL , MAX NM,M AXLE , 


DIMENSION 
EQUIVALENCE 
COMMON /CBITS / 


LEO, LEE, LRO,LRE,LRD 
LIMITSI2A ) 

(LIMITS, LHOI 
BITS, BLANK 


t 


C SEARCH FOR MATCHING BOUNDARY NAME 
LB = LBDO 

60 IF( BDT(LB).EO. BLANK .OR. LB.GE.LBDE) GO TO 80 
IF( BDT(LB) .EQ. BOYNAM) GO TO 70 
LB » LB+LBNEXT ( LB ) 

GO TO 60 

70 LBF - LB 
RETURN 

80 LBF * 0 
RETURN 
END 




OOOOO O O OOOOO 


_ *OECK LFIT1 

SUBROUTINE LF I T i I X , Y ,NPT S , XC.YC.NXC) 

*LFIT1 LINEAR FIT INTERPOLATION -LF I 1- 

DIMENS ION X ( 10 ) * Y( 10) , XC ( 10 ) , YC ( 10 ) 

INPUT- 

X » Y = LIST OF COORDINATES DESCRIBING THE INPUT FUNCTION 

NPTS = NUMBER OF X,Y POINTS 

XC = LIST OF X-S AT WHICH INTERPOLATION IS TO BE PERFORMED 
NX C = NUMBER OF XC-VALUES 

OUTPUT- 

YC = LIST OF VALUES INTERPOLATED AT XCIIC) , IC=1,NXC 
NOTES- 

IF XC IS OUTSIDE OF THE RANGE OF X, THE END VALUE OF Y IS SU 
FOR YC. 

X MUST BE LISTED FROM SMALLEST TO LARGEST. 

DOUBLE X-POINTS ARE ALLOWED FOR A FUNCTION DISCONTINUITY. 

N = NPTS 

I = 1 

C BEGIN INTERPOLATION LOOP FOR XC { IC ) , IC»1 ,NXC 
IC = 1 

60 XCIC * XC I IC I 

IF(N.GT.l) GO TO 100 
YC I IC ) =Y U ) 

GO TO 190 

100 XG = X( I + l I-XCIC 
IF(XG) 114,114,102 
102 XF = XCIC-XI I ) 

IF(XF) 110,120,120 

C F.LT.O. (F IS THE FRACTIONAL POSITION IN THE INTERVAL) 

110 I = 1-1 

IF(I) 100,111,100 

111 I =1 

YCI IC » = Y ( 1 ) 

GO TO 190 

C F.Gt.l. 

114 I * 1*1 

IFI I-N) 100, US, 100 
US I = N-l 

YC ( IC ) = YIN) 

GO TO 190 

C INTERPOLATE 

120 YC I IC ) = ( Y l I )*XG+Y(I+1)*XF)/I XG+XF ) 

C INDEX TO NEXT XCI IC) 

190 IC = IC+1 

IF! IC.LE.NXC) GO TO 60 

RETURN 
END 




♦ DECK 

CL0C2 

C 


L0C2 

FUNCTION LOC2 ( I A, IB) 

— CDC VERSION 

ABSI ADDRESS! IBI-ADORESSI IA) ) 
LOC2 = I ABS ( LOCF! IBI-LOCF! 1 A) ) 
RETURN 
END 




ooon ooo ooooooooo o ooooooo 


♦DECK LSPFIT 

SUBROUTINE L SPF IT l X, Y *NP T S* XC , YC , NXC • NO » 

•LSPFIT INTEGRATE OR INTERPOLATE -LSPFIT- 

INTEGRATE OR INTERPOLATE USING A PARABOLA WHICH PASSEO THROUGH THE 
AND (1*1) POINTS BUT MISSES THE (1-1) AND (1*2) POINTS (IF THEY BO 
EXIST) SUCH THAT THE SQUARE OF THE DEVIATION IS A MINIMUM. NOTE 
THAT I IS GENERALLY SELECTED SUCH THAT 
XII) .LE.XC.LT.X (1*1 ) 

THE EQUATION FOR THE PARABOLA IS 

Y-Y(I) = BMX-Xim ♦ C* I X- X ( I ) ) **2 

DIMENSION X ( 10 ) t Y ( 10 ) • XC ( 10 ) » YC ( 10) 

NOTE. THE DIMENSION -10- DOES NOT NEEO TO AGREE WITH THE CALLING 

INPUT- 

X, Y PTS. ON CURVE 

NPTS NO. OF X 

XC LIST OF X AT WHICH CALC TO BE DONE 

YC ( 1 ) INTEGRATION CONSTANT IF ND*-l 

NXC NO. OF XC 

ND =0 TO GET COORD, *1 TO GET 1ST DERIVATIVE, 

=-l FOR INTEGRATION 

LEND = LINEAR FIT IN END INTERVAL, T OR F 
OUTPUT 

YC COORDINATE OR DERIVATIVE AT XC OR 

YC ( IC ) = INTEGRAL I Y*DX) FROM XC ( 1 ) TO XC(IC) WHERE IC«2,NXC 

NOTES- 

-X- MAY BE IN EITHER ASCENDING OR DESCENDING ORDER. 

FOR INTEGRATION -XC~ MUST BE IN THE SAME ORDER AS -X-. FOR INTERP 
NO SPECIAL ORDER IS REQUIRED. 

COMMON /CL SPF / I, LEND 
LOGICAL LEND 

LOGICAL WITHIN 

DATA KNAME/6HLSPF IT/ 

N = NPTS-1 

IF(ND.EQ.f-l) ) 1 = 1 
ISAVE = 0 

SGN * SIGN(l.,X(N*l)-X(l>) 

C BEGIN INTERPOLATION LOOP FOR XCIIC) IC=1»NXC 
IC = 1 

_ C LOCATE APPROPRIATE INTERVAL 
100 I * MAXOI 1 , M I NO ( I , N ) ) 

W I T H I N= .FALSE. 

NCOUN T = N 

“ 102 IF I NCOUNT ) 119,103,103 

103 NCOUNT= NCOUNT-1 

XI = X ( I ) 

XD = XC( IC ) -X I 
1F(N) 104,120,104 

104 IF(SGN*XD) 105,107,110 




C F.tr.O. (F is THE FRACTIONAL POSITION IN THE INTERVAL) 

10* IF< I.tQ.i ) GO TH 120 

lFINn.EO.f-1)) GO TO 119 
1 = 1-1 
GO TO 102 

C F.EO.O 

107 IFIXI I+1).NE.XI ) GO TO 120 
I F ( I.GE.N ) GO TO 105 
GO TO 116 

C F.GT.O. 

110 IFI SGN*(XC( IC )-X( I+l )) ) 120,112,114 

C F.EQ.1.0, CHECK FOR IN Tl.GRATI ON AND DOUBLE POINT BEFORE INCREMEN 

112 I F I (ND.EQ . I - 1 ) ) .OR. (I.NF.N .AND. XU*l).E0.XfI«>2) ) ) GO TO 120 

C F .GT .1.0 

114 I F ( I.EQ.N) GO TO 120 

IF(ND.EQ.I-l) ) GO TO 122 
116 I = I+l 
GO TO 102 

119 CALL ERRORKIKNAHE ) 

C PRELIMINARY CALCULATIONS FOR INTERPOLATION OR INTEGRATION 

120 W I THIN= • TRUE • 

122 IFI I- I SAVE ) 124,129,124 
124 ISAVE * I 

YI * YII) 

X3 a XIIUHI 

Y3 * Y( H-1I-YI 

C « 0. 

TOP ■ 0. 

BOT - 0. 

I F ( LEND .AND. (I.EQ.l .OR. I.EQ.N)) GO TO 128 
IFI I.LE.l) GO TO 127 
XI » XI I - 1 ) - X 1 

x 1 3 * xi i-i ) -x i m ) 

TOP * Xl*< Y3*xi-(YI I-l )-YI )*X3)*X1 3 

BOT « Xl*Xl*X13*Xl3*X3 

127 IFI I.GE.N .OR. ( XD.EU.O. . AND . BOT.NE. 0. ) ) GO TO 128 

X4 * XI 1+2 ) — X I 

X43 * XI I ♦2 )-X I I+l) 

Y4 = YI I *2 )-Y I 

TOP » TOP + X4*( Y3*X4-Y4*X3)*X43 

BOT = BOT + X4*X4*X43*X43*X3 

128 IFI BOT.NE .0.) C = -TOP/BOT 

B =0. 

IFIN.GT.O .AND. X3.NE.0.) B = I YI I +1 )-YI ) /X3 - C*X3 

129 I F I NO ) 130,140,141 

C ND*-1» INTEGRATE 

130 IFI .NOT. WITHIN) XD»X3 

SI ■ (YI ♦ (B/2. + C/3.*XD)*XD)*X0 

IFIWITHIN) GO TO 135 

C -I- IS BEING INCREMENTED TO FIND APPROPRIATE INTERVAL. HENCE, 

OA 



C CUMULATE THE INTEGRAL OF THfc I TH INTERVAL. 

SA = SA ♦ SI 
GO TO 116 

C APPROPRIATE INTERVAL FOUND. XIII - XC (I C I -X (!♦ I ) 

135 lFIIC.EO.il SA = YC ( IC )- SI 
IF ( IC.NE.il YC( IC I -SA + Si 
GO TO 150 

C N0=0, INTERPOLATE FOR COORDINATES 

1 AO YC ( 1 C ) = Y I ♦ ( B ♦ C*XD)*XD 
GO TO 150 

C ND= l , FIRST DERIVATIVE 

1 A 1 YC( IC 1= B ♦ 2 • *C*XD 
GO TO 150 

150 1C * I C ♦ 1 

IHNXC-IC) 900, 160,160 

160 IF ( NO.NF. (-1) .AND.XC ( IC I .EO.XCI IC-ll) I-I + l 
GO TO 100 

900 RETURN 
END 


3 


♦ DECK L SUM 

SUBROUTINE LSUM(X,Y,N f S) 

♦LSUM — CUMULATIVE TAPE ZOIDAL INTEGRATION 

DIMENSION XI9),Y(9),SI9) 

DO 90 I =2 ♦ N 

90 s 1 1 ) = .5*iY(n*Yii-in*um-x(i-in ♦sn-n 

R» TURN 
ENl) 



-LSUM- 



o o o o 


-MBEGIN- 


♦OECk MBEGIN 

FUNCTION MBEG I N ( J2 ) 

♦MBEGIN FIND FIRST FIELD POINT 

C FOR A GIVEN STREAMLINE 

INPUT 

J 2 = STREAMLINE 1NOEX 

OUTPUT - 

MPEG I N = FIELD INDEX UF FIRST POINT ON THE SL 


COMMON /IXORIG/ LHO.LHE, LBDO »L BDE » LTO.LTE, LWO.LWE, LFO.LFE 

* LO.LESTA, LDUM ( 8 ) » 

* MO ,NM » NJtNFCOLSt MA XN J , MAXOL , MA XNM , MAXLE , 

* LEO, LEE. LRO,LRE,LRD 

DIMENSION L IMI TS ( 24 I 

EQUIVALENCE (LIMITS, LHO) 


, 


COMMON /CIDEX / M , J , MU , MO , I S T AG 
DATA KNAME/6HMBEGIN/ 


C SEARCH FOR FIRST POINT ON STREAMLINE J 
101 M =1 

10b CALL GETIX 

IF (J.EQ.J2 .AND. MU.EO.O) GO TO 115 
110 IF(M.EQ.NM) CALL ERR0RK1 KNAME ) 

1 12 M = M*1 

GO TO 105 


115 MBEGIN= M 
RETURN 



PRECEDING PAGE BLANK NOT FILMED 


♦DECK MOVE 

SUBROUTINE MOVE ( NR , X 1 , Y1 , N1 , ND1 , X2 , Y2 , N2 , ND2 , X3, Y3, N3 , ND3 ) 

CMOVfc FORTRAN SIMULATION OF MOVE (CDC) 

dimension xim , vim >,X 2 nit Y2( n ,x 3 mtYBii) 

DO 100 L = l » NR 
GO TO (5,10,15) , L 

5 N = IABS(Nl) 

NO = ND1 

I F C N1.LT.0 ) ND=- 1 
NS * N1 



GO 

TO 40 

10 

N 

= I ABS ( N2 ) 


ND 

= ND2 


I F ( 

N2.LT.0 ) ND=- 1 


NS 

= N2 


GO 

TO 40 

15 

N 

= IABSIN3) 


ND 

= N03 


I F ( 

N3.LT.0 ) ND=- 1 


NS 

= N 3 


40 K =1 

IF(NS )401, 100,41 
401 K = N 

41 I F ( (K.LE.O) .OR. (K.GT.N) .OR. NS.EQ.O ) GO TO 100 
GO TO (45,50,55) , L 

45 Y1(K) = X 1 ( K ) " 

GO TO 80 
50 Y2(K) = X 2 ( K ) 

GO TO 80 
55 Y 3 ( K ) = X 3 ( K ) 

80 K = K+ND 

GO TO 41 
100 CONTINUE 
RETURN 
END 


3 



♦DECK SETH 

SUBROUTINE SE TM ( NR » VAL ,X I , N1 , X2 ,N2 ,X3,N3) 
DIMENSION X 1 1 I ) ,X2(1) ,X3( 1) 

CSETM FORTRAN SIMULATION OF SLfM(CDC) 

DO 200 L-l.NR 
GO TO (105,110,115) , L 
105 NS * N1 
GO TO 140 
110 NS * N2 
GO TO 140 
115 NS = N3 
140 DO 180 K=1,NS 

GO TO (145,150,155) , L 
145 X 1 ( K ) = VAL 
GO TO 180 
150 X2(K) * VAL 
GO TO 180 
155 X3(K) ■ VAL 
180 CONTINUE 
200 CONTINUE 
RETURN 
END 




♦ OECK FMPYC. 

SUBROUT INE FMPYC ( NR ,C , XI , Y1 ,Nl , X2 , Y2 »N2 , X3 , Y3 ,N3 ) 
01 MEN SI ON Xl(l) ,Y1U ),X2< l> ,Y2( 1) ,X3(1) ,Y3(1) 

CFMPYC FORTRAN SIMULATION OF FMPYC (COC) 

DO 300 L= 1 » NR 
GO TO (205,210*215) , L 
205 NS = N 1 
GO TO 240 
210 NS = N2 
GO TO 240 
215 NS = N 3 
240 DO 280 K = 1 » NS 

GO TO (245,250,255) , L 
245 Y1IK) = C*X 1 ( K ) 

GO TO 280 

250 Y2(K) = C*X2(K) 

GO TO 2 HO 

255 Y 3 ( K ) = C*X3(K) 

280 CONTINUE 
300 CONTINUE 
RETURN 
END 



oooooooooooooon oooon oooooonoono 


♦ DECK Q I REM 

SUBROUTINE QIREM(X,Y f XJP, OV) 

♦OIREM- QUADRATIC INTERPOLATION ROOT EVALUATION -QIREM- 

C FOR FUNCTIONS WITH MAXIMUMS 

DIMENSION QV ( 8 ) 

DATA KNAME/6HQIREM / 

INPUT- 

X = ABSCISSA 

Y = ORDINATE (OR ERROR) 

XJP = X-JUMP TO BE TAKEN BEFORE ROOT/MAX IS SPANNEO, THE SIGN I 
A POSITIVE ERROR 

QV * STORAGE FOR EIGHT ELEMENT Q! RE VECTOR 
QV(I) = CTR =0. ( F IR ST ENTRY ONLY) 

YTOL « TOLERANCE ON THE ERROR 
YO = ORDINATE TO BE OBTAINED (OPTIONAL) 

DYDX = ESTIMATE OF SLOPE FOR 2ND GUESS (OPTIONAL) 

CTRMAX= MAXIMUM NO. OF ITERATIONS (=25 IF NOT SPECIFIED) 

OUTPUT- 

X = NEXT X ESTIMATE 

QV ( 1 ) = 0. IF YTOL HAS BEEN SATISFIED 

QV( 5 ) = 0. IF MAX PT HAS BEEN FOUND WITHIN YTOL, 

AND ABS ( E ) . GT .YTOL • 

NOTES- 

C = THIRD COEFFICIENT IN THE EQUATION- Y* A+B*X+C*X**2 

* DI2 IN Q I RE NOTATION 

Nl * EXIT VALUE OF QV ( 5 ) , Nl=4 IF X IS THE PRECICTED MAX PT, 
Nl*+5(-5) IF X IS JUST TO THE LEFT (RIGHT ) OF THE PREVIOUSL 
PREDICTED MAX PT , NI=6 IF X IS THE SECOND PT CLOSE TO THE 
OTHERWISE NI=N. 

M - ENTRY VALUE OF 0V(5) 

SGM • SIGN OF M IF ABS(M)»5 

SDYOX * SIGN OF THE SLOPE OF THE CURVE 

XJ * JUMP TO BE TAKEN FROM LAST X 
XJA = ABSOLUTE VALUE OF MAXIMUM JUMP = ABS(XJP) 

XM * DISTANCE FROM CENTRAL PT TO MAX/MI N OF PARABOLA, =XMAX-XX( 
OR = DISTANCE FROM CENTRAL PT TO THE ROOT, =XR00T-XX(2) 

XI = INPUT (OR LAST) X VALUE 

COMMON /CQIREM/ YTOL ,Y0, DYDX ,CTRMAX 

COMMON /ERASE / BOT , C ,DXDY,E , 1 , 1 1 , IN , I SPAN, M,N,RADICL , SDYDX,SGN, 

I TOP,Xi,X13,X13P,XJ,XJA,XM, DX ( 3) ,DYt 3 ) • QVl ( 10 ) 

DIMENSION XX ( 4 ) , YY ( 4 ) 

EQUIVALENCE ( CTR , QV 1 ( 1 ) ) , ( NI , QI ND, QVl ( 5 ) ) , 
l ( XX , Q VI ( 2 ) ) • l YY »QVl ( 6 ) ) 

C INITIALIZING AND PRELIMINARY CHECKING 
IF(CTRMAX.EQ.O. ) CTRMAX=25. 

00 30 1 = 1,8 
30 QV1( I )= QV( I > 

Nl * I F I X ( QV I ( 5 ) ) 

E » Y-YO 

M = Nl 

IF ( CTR.EQ.O. ) M»0 
SGM = 1. 




IF(M.GE.O) GO TO 36 
M = 5 

SGM = -1. 

36 N = M I NO ( M , 3 ) 

C SDYCX = S I GN ( 1. f-XJP ) 

C (ALTERNATE CALC TO CIRCUMVENT COMPILER ERROR) 

IF(XJP) 41,42,42 

41 SOYOX = 1. 

GO TO 43 

42 SOYOX = -1. 

43 X J A = ABS(XJP) 

Xi = X 

I F ( M- 5 ) 44,45,46 

44 IF(ABS(E).LE.YTOL) GO TO 800 

IFJM.E0.4 .AND. A BS ( E- YY ( 2 ) ) . LE . Y TOL ) GO TO 700 
IF(CTR.GE.CTRMAX) CALL ERRORK ( KNAME ) 

GO TO 50 
46 M =3 

45 X13P = XX( i)-XX( 1 ) 

C DETERMINE IND» X FUR INSERTING CURRENT X,E INTO XX, YY TABLE WHICH IS 
C ORDERED ACCORDING TO X. 

50 IN =1 

IF (N.EQ.O) GO TO 90 

60 I F I XX I IN) .GT.X1 ) GO TO 70 
IN = IN+1 * 

IF ( IN.LE.N) GO TO 60 

GO TO 90 

C RELOCATE IN PREPARATION FOR INSERTING X,E 
70 II = N+L 
HO XX ( I 1 )= XX ( I I- l ) 

YY ( I I ) = YY ( l I - 1 ) 

II =11-1 

IF(1 1.NE.IN) GO TO 80 

C INSERT NEW POINT 

90 N ~ N* 1 

XX ( IN ) = XI 
YY ( IN > = E 

C LOCATE INTERVAL WHICH SPANS RUOT 

ISPAN = 0 

IF ( N. EC. 1 ) GO TO 200 
00 110 1=2, N 

IE (SDYDX*YY(I) .GT.O. .AND. SDYDX*YY (I-l).LT.O.) ISPAN=I 
110 CONTINUE 

C REDUCE XX, YY TABLE TO THREE POINTS 
IF ( N.LE .3 ) GO TO 200 

I F ( ISPAN. EO.O) GO TO 140 
C (ROOT HAS BEEN SPANNED) 

122 IF( ISPAN. EO.N ) GO TO 150 
1 F { ISPAN. EO. 2) GO TO 175 
IF(ABSCYY(ll ).GT.ABS(YY(4)) J GO TO 150 
GO TO 175 



C 


(ROOT HAS NOT HEIN SPANNED) 



o o o 


140 IFC IN.LE.2I GO TO 175 

C DELETE FIRST POINT 

150 DO 160 I - 1 » N 

XX ( I ) = XX ( I + 1 ) 

160 YY { I ) = YY( 1 + 1 ) 

ISPAN = I SPAN-1 
C DELETE FOURTH POINT 

175 N * N-l 

C SIMPLE X-JUMP PREDICTION 

200 N1 = N 

IF( ISPAN. GT.O .OR. DYDX.NE.O.) GO TO 205 
C XJ « SDYDX*S IGN(XJA,-E ) 

C (ALTERNATE CALC TO CIRCUMVENT COMPILER ERROR) 

XJ ■ XJP 

IFCe.LT.O.I XJ — XJ 
GO TO 900 

C CURVE FIT PREDICTIONS 

205 IF(N-2> 210,220,300 

C ONE POINT PREDICTION BASED ON INPUT VALUE OF DXDY 
210 XJ = -E/DYDX 

GO TO 900 

C TWO POINT STRAIGHT LINE PREDICTION / 

220 BOT = YY 12 ) — YY ( 1 ) 

I F ( BOT.EQ.O. ) GO TO 230 
DXDY » ( XX ( 2 )- XX ( 1 ) ) /BOT 
IF(DXDY*SDYDX.GT.O. ) GO TO 240 
C (CURVE SLOPE IS WRONG > MOVE TOWARD MAXIMUM POINT) 

230 XJ ■ -3.*SDYDX*XJA 
GO TO 900 

C (CURVE SLOPE IS CORRECT) 

240 XJ ■ -E*DXDY 

GO TO 900 

C PARABOLIC CURVE FIT PREDICTION 

300 DX( 1) = XX( 1 )-XX ( 2 ) 

DX ( 3 ) = XX ( 3 )— XX ( 2 ) 

DY ( i) = YY ( 1 )— YY ( 2 ) 

DY ( 3 ) = YY( 3 ) -YY ( 2 ) 

BOT = DX ( 1 ) *DY ( 3 ) - DX(3)*DY(1) 

IF(ABS(B0T).LT.1.E-12) GO TO 600 

TOP = DX( 1 ) *DX ( 1)*DY(3) - DX( 3 )*DX ( 3 ) *DY ( 1 ) 

XM = . 5*T0P/B0T 

X 13 = XX( 3)-XX( 1 ) 

IF(ABS(XM).GT.ABS(1.E3*X13)) GO TO 600 
C » BOT/(DX( 1 )*DX(3)*X13) 

RADICL* XM*XM - YY(2)/C 
I F ( RAD ICL . LE • 0. ) GO TO 360 
SGN * S I GN ( l • , SDYDX*C ) 

XM « XM ♦ SGN* SORT (RADICL ) 

GO TO 890 

(IMAGINARY ROOT, HENCE WE ARE LOOKING FOR THE MAXIMUM POINT* 
PREDICT MAX PT IF M=3, SELECT PTS ON LEFT/RIGHT SIDE OF PREVIOUSLY 
PREDICTED PT IF M=4/5) 




_ 160 IFIM-6) 363 t 366 » 365 

363 IF( ARS(XM).LT.XJA) Nl = 6 
GO TO 890 

366 XJ = -X13/8. 

~ Nl = 5 

IF ( IN.GT.2I GO TO 900 
XJ = -XJ 

- N 1 = - 5 

GO TO 900 

365 XJ = SGM*Xl3P/6. 

_ Nl =6 

GO TO 900 

C RURtAI TO LINEAR INTERPOLATION 

~ 600 IF ( ISPAN.GT .0 ) GO TO 122 

GO TO 160 

- C MAXIMUM FOUND 

700 OIND = 0. 

GO TO 930 

~ C SOLUTION FOUND 

800 CTR = 0. 

GO TO 930 

C FINIS 

890 XI = XX ( 2 ) *XM 

- GO TO 910 

900 XI = Xl+XJ 

910 CONTINUF 

_ X AMAX1 (XXI 1 J-XJA, AMIN1 ( X 1 , X X ( N> +X J A )) 

CTR = C TR ♦ 1 . 

930 DO 950 1=1, H 

950 OV ( I ) = UV1 ( I ) 

- OV ( 5 ) = FLOAT(Nl) 

999 RETURN 

END 
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* DECK UBpHl 

SJBRUUTINl TABPR I ( NAML , A ,NA , NCOL 1 ) 

CTABPRT CDC VERSION 

DIMENSION A ( 10) 

INPUT- 

NAME = ARRAY NAME TO BE PRINTED 

A = ARRAY TO BE PRINTED 

NA = NUMBER OF ELEMENTS 

NC0L1 = NUMBER OF COLS. TO BE USED IN PRINT FORMAT 
$$S$S (MAXIMUM = NA ) 

IITAB = LOC. OF FIRST ELEMENT IN A TO BE PRINTED 


COMMON /CHITS / IBITS, BLANK 
COMMON /CTABPR/ IITAB 

EUU I VALENCE l L SPACE , ASPACL » , (IB,B) 

DIMENSION FMT ( 12) 

REAL 112 

INTEGER HOLLtHTEST 
DATA IBCI/0010000000000/ 

DATA (FMT(J),J=1,12)/10H(1X,I5 ,10H »10H , 

*10H . 1 OH t 10H t 1 OH * 

*10H , 1 OH f i OH tlOH * 

* 10H )/ 

DATA 

* FI, F3, F6, E5, BCD, OCT, 112/ 

*6H, F 1 2 • 1 » 6H, F 1 2 . 3 , 6H.F12.6, 6H.E12.A, 6H,6X,A6, 6H,8X,0A, AH, 112 
*/ 

DATA HMASK/000000000000077777777/ , HTEST/000000000000055555555/ . 

* INMASK/037777777000000000000/ 

DATA NINMSK/077770000000000000000/ 

NCOL * M INO( NCOL 1,10) 

NB « NA 

C WRITE HEADING 

WRITE (6,10001 NAME 

A5 II * IITAB 

I * II 

12 =0 

C WRITE LINE SPACE 

A 7 WRITE (6,1002) 

C LOCATION OF NEXT LINE SPACE IS GIVEN BY All+l) 

ASPACE= A ( I+I ) 

I F ( L SPACE .LE • 1 .OR. LSPACE .GE. IBC I > LSPACE=IBCI 
L S P AC E = LSPACE+I-1 
GO TO 110 


C 

C 

C 

C 


BEGIN LOOP TO DEFINE LINE FORMAT 
A8 II =1 


50 B * A( I ) 


SPECIAL NUMBERS 
NN = NINMSK.AND.B 
I F ( NN.EQ.N INMSK ) GO TO 82 
TEST FOR HOLLERITH (6H 


MAX.) 



HOLL = HMASK.AND.B 
I F ( HGLL .fcO.HTEST ) GO TO 80 

C TEST EUR INTEGER (BITS 36-58=0 FOR MAX 635 INTEGER 

C FLOATING POINT NUMBERS NORMALIZED 

IF( I6.LC.IH ITS I GO TO 85 
INTGR =. INMASK. AND. IB 
I F ( IUTGR.EQ.0 ) GO TO 82 
C REAL NUMBER — NORMALIZED 
B = ABS(B) 

E MT ( I l + 1 ) = £5 

IH B.LT.l.L-3 .OK. H.GE.l.EH ) GO TO 90 
6 5 fVT (I l ♦ II = If. 

I f ( H.r.l, . 1.1 I ) I Mill I +1 )*F3 

IK K. <11 . 1.1 5 ) EMM I I ♦ 1 ) *F 1 

GO III 9u 

C BCD 

dO EMT ( I 14 1 )= BCD 
GO TO 90 

C INTEGER 

d2 FMT (I 1 + 1 )= H2 
GO TO 90 

C OCTAL 

8 5 FMT (II+1)= OCT 
9) II = Il + l 

I =1 + 1 

IF( I .GT.LSPACE ) GO TO 1 >0 
IM Il.LE.NCOL .AND. l.Lt.NB ) GO TO 50 
100 12 = 1-1 

W« I II ( (> , f M I ) I 1, ( A< 1) , I = 11, 1 2) 

II = I 

1 .0 IF I I .(,1 .ND ) GO 10 990 

IF ( I .GT.LSPACE ) GO TO A 7 
GO TO A 8 
99u UTAH = 1 
1 0 uO FORMAT ( /2X f A6 I 
10'Jc F0RMAU1H I 
RETURN 



END 



TAN(X) 


♦DECK TAN 

FUNCTION 

* T AN -TAN- 

TAN = S INI X ) /COS I X ) 

RETURN 

END 
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* OF CK SS5PT 

SUBROUTINE SS5PT 

♦SS5PT SUPERSONIC 5-PT FORMULA -SS5PT- 


I NPU I — 

X ( 1 -^ > = POINT SPACING FROM POINT ZERO 

A4FACT= 1 FOR CUBIC, =0 FOR SAME A4 AS A PARABOLA 


C 

C 


UUTPUT- 

AO, Al , A2, A3,A4= INFLUENCE COEFFICIENTS FOR D2Y/DX2 AT X ( 4 ) 


COMMON /CSS 

1 

INTEGER 

LOGICAL 


/ ssfml,ssef,sseang,ssof,ssfend,ssfndi 

, SSDLE, A4FACT.BR LX, CURRLX,TSIC 
SSFML 

SSEF, SSDF, SSDLE 


COMMON /CSS5PT / X(4),Y(4), X 2 I , X3 1 ,X32 , X4 1 , X42 ,X43 « AO* A1 , A2, A3 , A4 


X43 


X ( 4)-X( 3) 


X42 

- 

X ( 4 )- X C 2 > 


X41 


X I 4 )- X ( 1 ) 


X32 

= 

XI 3 ) -X ( 2) 


X 31 

= 

X( 3)-X( 1 ) 


X 2 1 

= 

X l 2 )- X t 1) 


A4 

= 

2./ ( X42*X43)*( 1.+A4FACT*! X42+X43) /X41 ) 

A I 

= 

<-A4*X(4 J*X42*X43 ♦ 

2 •* ( X (4 I +X42+X43 ) )/ 

I 


C X ( l)*X2i*X31) 


A 2 

= 

( +A4*X( 4 ) * X4 1+X4 3 - 

2.*tX(4)+X4i*X43n/ 

1 


(X(2)*X2l*X32) 


A3 

= 

l-A4*X(4)*X41*X42 + 

2.* ( X ( 4 ) +X41 + X42 1 )/ 

1 


1 X ( 3 ) *X 3 1 *X32 ) 


AO 


-( A1+A2+A3+A4) 



RETURN 

END 
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♦DECK STANO 

SUBROUTINE STANO ( M ,LR , UPPER ) 

♦STANO- STATION INDEX FROM FIELD POINT -STANO- 

LOC1CAL UPPER 


INPUT- 

M * FIELD PT INDEX 

LR -0 FOR FIRST ENTRY OTHERWISE LR.NE.O 
OUTPUT- 

LR * STATION TABLE INDEX 

UPPER * T IF M IS AN UPPER BOUNDARY POINT, »F OTHERWISE 


COMMON /IXORIG/ LHO, LHE, LBDO,LBDE , LTO, LTE • LWO.LWE, LFO,LFE, 

♦ LOfLESTA, LDUM ( 8 ) , 

♦ MO »NM , N J ,NFCOLS, MAXNJ,MAX0L ,MAXNM,MAXLE , 

♦ LEO, LEE, LRO»LRE *LRD 

DIMENSION L I MI TS ( 24 ) 

EQUIVALENCE (LIMITS, LHO) 

STATION TABLE 
INDEX- L=LO,LESTA 

SCHOK E= STATION CHOKE INDICATOR ( ADJWF ,BRHS, WRIOUT ) 

MCL = SHARP CORNER INDICATOR (BLDTBS) 

MCL = FIELD INDEX OF CONTROL STREAMLINE ( PTMOVE »FLOBAL ) 

COMMON /CHDATA/ XI ( I ) , LNE XT ( i ) , MLB ( I ) , MUB (1) , PRI M< 1 ) , 

I TYPELB(I) ,NAMELB( I) , ILB ( 1 ) ,FLB(1 ) ,SILB( I ) , 

1 TYPEUB ( I ) , NAMEUB ( I ) , IUB ( I > , FUB ( I ) , S iUB ( I ) , 

3 VMB( I),DWDV(1), X2CL(1),VCUI),MCL(481> 


LOGICAL PRIM 

INTEGER TYPELB, TYPEUB 
DIMENSION SCHOKE(I) 

EQUIVALENCE ( SCHOKE , DWDV ) 

DATA KNAME/6HST ANO / 


L * LR 

IF(L.tQ.O) L ■ LO 
UPPER ■ .FALSE. 

LSAV - L 
L STOP 3 999999 

120 I F ( L . GE .L STOP ) CALL ERRORKl KNAME ) 

IF(MUB(L ) .EQ.M) GO TO 150 

IF(M.GE.MLBtL) .AND. M.LE.MUB(L)) GO TO 160 
L 3 L+LNEXT ( L ) 

IF(L.LT.LESTA) GO TO 120 
L ■ LO 

LSTOP 3 LSAV 
GO TO 120 

150 UPPER 3 .TRUE. 

160 LR = L 

RETURN 

END 
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* OF CK STAX l 

SUBROUTINE ST AX 1 ( X IF I NO , X2B , ; 2A , L XB , LXA ) 

*SiAXl- STATION INDEX FROM XI AND X 2-COORD I NATES -STAX1- 


INPUT- 

X 1 F IND= X 1 -COORD I NAT E 

X2B = X2-COORDINATE OF UPPER BOUNDARY U.E. STATION BELOW THE BO 

X 2 A = X2-COORDINATE OF LOWER BOUNDARY (I.E. STATION ABOVE THE BO 

OUTPUT- 

LXb = INDEX OF STATION WHICH CONTAINS COORD l NA T E S-X IF I ND, X2B 

LXA = INDEX OF STATION WHICH CONTAINS COORD I NATE S-X IF INDtX2A 

COMMON /IXORIG/ LHO,LHE, LBDO ,LBDE » LTO» LTE , LW0,LWE, LFO,LFE, 

* LO » LESTA » LDUMI8), 

* MO » NM » NJfNFCOLSt MAXNJ* MAXOL #MAXNM» MAXLE * 

* LEO, LEE, LRO , LRE , LRD 

DIMENSION LIMITSI24) 

EQUIVALENCE (LIMITS, LHO) 

COMMON /SL TAB / W ( 12 8 ) , X 2 ( 1 28 ) , SLCHN ( 128 » 

INTEGER SLCHN 
STATION TABLE 
INDEX- L=LO, LESTA 

SCHOKE= STATION CHOKE INDICATOR ( ADJWF ,BRHS , WRIOUT I 
MCL = SHARP CORNER INDICATOR ( BLDTBS ) 

MCL = FIELD INDEX OF CONTROL STREAMLINE I PTMOVE , FLOBAL ) 

COMMON /CHDATA/ X I ( 1 I , LNE XT (1) , MLB ( 1 ) * MUB ( 1 ) , PRI M ( 1 ) , 

1 TYPELBd I ,NAMELB( 1 ),ILB(I),FLB(1),S1LB(1), 

1 TYPEUB ( i ) ,NAMEUB(1 ) , IUBli ) , FUB ( 1 ) , S IUB ( 1 ) , 

3 VMB( 1 ) » DWDVI i ) * X2CL(1),VCL(1)«MCL(481) 

LOGICAL PRIM 

INTEGER TYPELB, TYPEUB 
DIMENSION SC HOKE ( 1 ) 

EQUIVALENCE ( SCHOKE , DWDV ) 

COMMON /CIDEX / M , J , MU ♦ MD , I S T AG 
DATA KNAME/6HSTAX1 / 

NFOUND= 0 

I F ( X2B.GE.O. ) NFOUND= 1 

IF ( X2A.GE .0. ) NF0UND=NF0UND+1 

L = LO 


110 IF(XKL).NE.XIFIND) GO TO 120 
M = MUBIL ) 

CALL GETIX 

IF(X2( JI.NE.X2H) GO TO 115 
LXB = L 

NF OUND= NFOUND-1 

GO TO 120 
1 15 M = MLB ( L ) 

CALL GETIX 

IF(X2(J).NE.X2A) GO TO 120 
LXA = L 
NFOUND= NFOUND-1 
120 L = L+LNEXT ( L ) 

IF ( NFOUND.EQ.O ) GO TO 130 
IF ( L.LT. LESTA ) GO TO 110 




♦OECK STCN 

PROGRAM STCN 

COMMON /CTAPOS/ RESTRTf ENOBDT, STCFIL.K6SV 
LOGICAL RESTRTt ENOBDT » STCFI L 

COMMON /SELECT/ LLNTRY 
I GO TO (5,10) , L ENTRY 
C READ INPUT 

5 CALL OVERLAY! 3HSTC,1,1,6HRECALL) 

GO TO 20 

C BUILD TABLES 

10 IF(RESTRT) GO TO 15 
LENTRY= 1 

CALL OVERLAY( 3HSTC, 1,2,6HRECALL ) 

CALL 0VFRLAY(3HSTC,1,3,6HRECALU 
LENTRY= 2 

12 CALL OVERLAY! 3HSTC, l ,2,6HRECALL ) 

GO TO 20 
C RESTRT CASE 
15 L E N T R Y = 2 

CALL OVERLAY! 3HSTC, 1,3, 6HRECALL) 

L ENT R Y= 3 
GO TO 12 
20 RETURN 
END 
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♦DECK ERRORN 

SUBROUTINE ERROR 1 

CEDUMPN STC EDUMP - INPUT LINK -EDUMPN- 


C 

C 


COMMON /ALLCOM/ MACHA,PS 


1 

2 


REAL 

LOGICAL 

LOGICAL 


. If-. VI » I ^ f » wri f I inf I I F 

machc,psc,tsc,ptc,ttc, 

daxit,scalea,tte,chotst 

MACHA ( 1 ) » MACHC 
AXIA tAXIC 
CHOTST 


CHANNEL INPUT DATA TABLE 


AXIA, RGA, GAMA 
AXIC , RGC, GAMC 


» 

t 


INDEX- LH=LHO , LHE 


COMMON /CHDATA/ CHNAM ( I ) , LHNfc XT ( 1 ) , WTFLOWl I ) , TTO ( 1 ) ,PTO( I ) , 

1 TSOI 1) ,P SOU) , MACHO m,AO(l) , VARY (1) , 

2 KC(l),GAM(l), NR ( 1 ) * NC ( l ) , T AB ( 6) » 

A BB (751 

LOGICAL VARY 

INTEGER CHNAM 
DIMENSION 
REAL 

EQUIVALENCE 
BOUNOARY TABLE 
INDEX- LB=LBDO, LBDE 


VOID 
MACHO 
( VO, MACHO) 


LBNEXT= INCREMENT TO NEXT BOUNDARY 

LBZ I = INCREMENT TO THE FIRST BOUNDARY POINT (*0 BEFORE COALLATIO 
CHNAME= CHANNEL WITH WHICH THE BOUNDARY DATA IS ASSOCIATED 
UP = T OR F FOR UPPER OR LOWER BOUNDARY 

LEDEX = RELATIVE INDEX OF L.E. POINT WHEN LOWER AND UPPER SURFACE 
CONTOURS ARE CONNECTED 

BDNAME , LBA , LBB=NAME AND INDEX LIMITS OF SPECIFIC BOUNDARY 

DATA WHEN BOUNDARIES ARE COALLATED 
DIMENSION BDT ( I ) , L BNEXT C I ) , LBZ 1 ( l ) , 

1 CHNAMEl I ) »UP( 1) , LEDE X 1 1 ) , 

2 ZBTI 1),RBT(1)«ANGBT(42) 


LOGICAL UP 

INTEGER BDT, CHNAME, BDNAME 

DIMENSION BDNAME U ) .LBAC1 ) , LBB(L) 

EQUIVALENCE ( BDNAME , ZBT ) , ( LBA ,RBT ) , ( LBB , ANGBT ) 
FLOW ADJUSTMENT TABLE 


INDEX- LF*L FO , L FE 
NFCOL S= 8 

X I F = ORTHOGONAL COORDINATE 

X2F = STREAMLINE COORDINATE OF SL EMINATING FROM T.E. 

XIBF = X 1-COORDI NATE OF CHOKE STATION OF FLOW BELOW T.E. 

X 1 AF = X i-CQORD I NATE OF CHOKE STATION OF FLOW ABOVE T.E. 

SIF = SI-COORDINATE OF T.E. (UPPER SURFACE). THIS ITEM 
IS USED WHEN INTERPOLATING FOR WAKE DELTA-STAR. 
LFB,LFA*INDICES OF STATIONS BELOW AND ABOVE T.E. 

NCHB, NCHA*NUMBER OF CHANNELS BELOW AND ABOVE T.E. 

LRF « INDEX OF DUMMY ORTCHN LIST FOR THE T.E. 

LRXF » INDEX OF LAST CHANNEL BELOW THE T.E. 

JORDER* 0 IF TOTAL FLOW AT XIF IS GIVEN 

* 2 IF FLOW ABOVE T.E. IS GIVEN 

* 1 IF FLOW BELOW T.E. IS GIVEN 

JORDER* -l IF FLOW AT XIF IS CHOKED AND SINGLE CHANNEL 
DIMENSION X1F( 1 ) , X 2 F ( l) ,XIBF ( I ) , XI AF ( 1 ) , 

I S IF ( i),NCHB(l)«NCHA(l) , JORDER ( 1 ), VNR ( 12 ) 

(LFB,X1BF ), (LFA.XIAF ) , (LRF, NCHB) , (LRXF*NCHA) 


EQUIVALENCE 
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DIMENSION L FBI 1 ) ,LFA( 1 j ,LRF (1) ,LRXF ( l ) 

TABLE OF CONVECTED PROPERTIES 
INDEX- L T=L TO ♦ L TE 
CH = CHANNELNAME 

L TNEX T= INDEX INCREMENT TO THE NEXT CHANNEL 
L PS I = RELATIVE LOCATION OF PSI LIST 

NPT = NO. OF PSI, TT, PT AND RCU VALUES 

LTT = RELATIVE LOCATION OF TT LIST 

LPT = RELATIVE LOCATION OF PT LIST 

LRCU = RELATIVE LOCATION OF RCU LIST 

DIMENSION CH(l) .LTNEXTIU ,NPT(1) ,LPSI (II »LTTU I tLPTII) » 

1 LKCU(l), 

2 CRGI 1) ,CPGJ( 1 ) , C 2C P ( l ) » QGAM ( l),FGT(l),FGP(l), 

3 FGR(l) ,AREAT b(4B5) 

INTEGER CH 

DIMENSION XCH(l) 

EQUIVALENCE ICH.XCH) 

STREAMLINE TABLE 

COMMON /SLTAB / w( 128) , X 2 < 128 ) ♦ SLCHN ( 128 > 

INTEGER SLCHN 
STATION TABLE 
INDEX- L=LO, LESTA 

SCHOK E= STATION CHOKE INDICATOR ( ADJWF , BRHS , WRIOUT ) 

mcl = sharp corner indicator (bldtbsj 

MCL = FIELD INDEX OF CONTROL STREAMLINE ( PTMOVE ,FLOBAL ) 

DIMENSION XI ( 1 ) , LNE XT ( 1 ) » MLB ( I ) ,MUB I 1) t PRI M ( 1 ) , 

1 TYPELB(I) .NAMELBIl), I LB ( 1 ) , FLB ( I ) , SlLB ( I ) , 

I TYPEUUI I ) .NAMEUBI I ) , I UB ( 1 ) ,FUBll I ,SIUB( 1 ) . 

3 VMB ( 1 ) ,0 WDV ( i ) , X2CL(I),VCUI)fMCL(4Bn 

LOGICAL PRIM 

integer typllb,t ypeub 
dimension SCHOKE(l) 

EQUIVALENCE < SCHOKEf dwdv j 

table of wake displacement thickness 

INDEX- L W = L WO , L WE 

DIMENSION X2W( 1 ) »L WNEXT (II »SI W (47 ) 

DIMENSION DST(l) 

EQUIVALENCE (DST,S1W) 

SUBTABLE ARRANGEMENT IS- 

X2W,LWNEXT(=2+2N) , SLH(1)«SIW(2)...S1M(N)« DST(l) , DSTI 2 ) , . .DST ( N ) 
X2W = STREAMLINE COORDINATE 

SIW = DISTANCE ALONG STREAMLINE FROM T.E. 

DST = WAKE DISPLACEMENT THICKNESS AS A FUNCTION OF SIW 

FIELD TABLES 
INDEX- M=MO , NM 
COMMON /Cl / Z ( 300 ) 

COMMON /CR / R ( 300 ) 

COMMON /CS2 / S 2 ( 300) 

COMMON /CS1 / S 1 ( 300 ) 

COMMON /CPHIl / PHIK300I 
COMMON /CM / J M S ( 300) 

COMMON /CCURV / CURVI300) 

COMMON /CB / B ( 300 ) 

COMMON /CIDEX / M , J , MU , MD , I S TAG 

C TABLE OF INDEX LIMITS 

COMMON /IXORIG/ L HO, LHE , LBDO »LBDE , LTOtLTE, LWO,LWE, LFO,LFE « 
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* LOtLESTA , LDUM ( 8 ) * 

* MO,NM, N J ,NFCOLS» MAXN J , MAXOL • MAXNM , MAXLE , 

* LEO, LEE, LRO,LRE ,LRD 

DIMENSION LIMITS(24) 

TABLE OF LEADING EDGE AND TRAILING EDGE POINTS 
INDEX- LE=LEQ,LEE , 10 

NLE,NTE=N0. OF L.E. AND T.E. COINCIDENT PTS, RESPECTIVELY 
CHL , CHU=NAME OF CHANNEL ABOVE AND BELOW PT, RESPECTIVELY 
BDL » BDU=BOUNDAR Y NAMES ASSOCIATED WITH THE POINTS 

NUSED » COUNT OF TIMES THAT POINT USED IN CONSTRUCTION OF /ORTCHN/ 
COMMON /LETEPT/ XL ( l ) , YE ( 1 ) , ANGE ( l ) , NLE ( 1 ) ,NTE ( 1 > , 

I CHL ( 1 ) ,CHU( 1 ) ,BDL ( I ) ,BDU<1) , NUSED (49 l I 

INTEGER CHL , CHU , BDL , BDU 

TABLE OF CHANNELS EMBRACED BY EACH ORTHOGONAL 
INDEX- LR=LRO»LRE , LRD 

LRD = NUMBER OF CHANNELS PLUS ONE, LR INDEX INCREMENT 
LEDGE = INDEX OF THE ORTHOGONAL POINT IN THE LETEPT-TABLE 
LRPRE V= POINTER OF LINE OF UPSTREAM CHANNELS IN ORTCHN-TABLE 
CHNA = CHANNEL NAMES 

COMMON /ORTCHN/ L EDGE (l ) • LRPREV III ,CHNA (479 I 
INTEGER CHNA 
DIMENSION JCHNA(i) 

EQUIVALENCE ( JCHNA ,C HNA I 

EQUIVALENCE ( CHNAM , BDT ,CH , X2 W, X1F , XI > 

EQUIVALENCE l LHNE XT ,L BNEXT ,LTNEXT tLWNEXT, X2F, LNEXT ) 

EQUIVALENCE { WTFLOW, LBZ1 , NPT ,S1 W, XIBF , MLB ) 

EQUIVALENCE ( TTO.CHNAME ,LPSI ,X1AF ,MUB) , ( PTO, UP, LTT, S1F , PR IM ) 
EQUIVALENCE ( TSO, LEDE X ,LPT ,NCHB ,T YPELB ) 

EQUIVALENCE ( PSO, ZBT, LRCU ,NCHA , NAMELB ) 

EQUIVALENCE ( MACHO, RB T ,CRG , JORDER , I LB > , (AO, ANGST ,CPGJ , VNR , FLB ) 
EQUIVALENCE ( VARY ,C2C P , S1LB) , ( RG ,QGAM, TYPEUB ) 

EQUIVALENCE ( GAM, FGT, NAME UB) , ( NR ,FGP , I UB ) , ( NC » FGR, FUB ) 
EQUIVALENCE ( TAB ( 1 ) , AREATB ,S IUB ) , ( TAB ( 2 ) , VMB I , ( TAB ( 3 ) , DWDV ) 

EQUIVALENCE ( T AB ( A ) , X 2CL ) , ( TAB ( 5 ) , VCL ) , (TAB(6),MCL) 

COMMON /CBITS / BITS, BLANK 

COMMON /CREDIN/ Z TRANS, R TRANS , ROTA TE , ZP I VOT , RPIVOT , SC ALE , NB,T BB ( 9 ) 
EQUIVALENCE ( XTRANS, Z TRANS) , ( Y TRANS, RTR ANSI , (XPIVOT ,ZPIVOT ) , 

1 (YPIVOT, RPIVOT) 

COMMON /CTABPR/ I 1TAB 

COMMON /CSEGME/ I A ( 10 ) , I B ( 10 ) , I MA ( 10 ) , I MB ( 10) , JTYPE ( 10 ) , 

I N , NSEG, N I ,N I M 

COMMON /CSMOOB/ XA ( 100) , YA( 100) , DEVI (100) 

COMMON /CSMOOC/ DUMi (200 ) , ANG U 00 ) ,DUM2 ( 400) ,DEV( 100) ,CURVB( 100 ) 
DATA TXA/2HXA/,TZA/2HZA/ 

IGGO * 1 
GO TO 1777 
ENTRY EDUMP 
IGGO = 2 
1777 CONTINUE 

1100 FORMAT ( ///1X36HCHANNEL INPUT DATA TABLE, /CHDATA/ -) 

WRITE (6,1100) 

I1TAB = LHO 
NCX = NC 
IF(NCX.LT.3) NCX=5 




CALL TARPRT ( BLANK ,CHNAM, LHE ,NCX ) 


1120 FORMAT </// IX84HB0UNDARY COORDINATES AND ANGLES IN RADIANS, /BDYTAB 
♦/ - ) 

WRIT I (6,1120) 

1 1 TAB = L BOO 

CALL TABPRT(BlANK,BDT,LB0E,3) 

1110 FORMAK ///IXAIHTabLF OF CONVICTED PROPERTIES, /CONVTB/ -) 

WRITE (6,1110) 

UTAB = L TO 

CALL TABPRT(BLANK,CH,LTE , 7) 

IF( LEE.LT. LEO) GO TO 140 

1130 FORMAT ( ///1X125HORDERED LIST OF UPSTREAM BOUNDARY PNTS, L.E. PNTS, 

* T.E. PNTS, AND DOWNSTREAM PNTS WITH REFERENCES TO CHANNELS AND BO 

*UNDAR IES./1X10H/LETEPT/ - //4X2HLE 6 X , 2HXE1 OX , 1 5HYE ANGE12X, 

♦3HNLE9X, 12HNTE CHL9X , 3HCHU9X, 3HBDL9X , 3HBDU1 OX , 5HNUSED > 

WRITE (6,1130) 

I1TAB = LEO 

CALL TARPRT(RLANK,XE,LEE ,10) 

140 IF(LRE.LT.LRO) GO TO 150 

1140 format ( ///ixorhtahulat ion of channels embraced by the orthogonals 

♦WHICH PASS THROUGH THE ABOVE POINTS, /ORTCHN/ -//4X26HLR 
♦Lfc LR-PRLV) 

WRITE (6,1140) 

UTAR = LRO 

CALL TABPRT ( BLANK , LEDGE , LRE , LRD ) 

1150 FORMAT! / / / 1 X 1 7HSTREAML I NE TABLE -/ 1 7X32HJ X2 SLCHN 

♦ W/( I 18.E12.6.6X, A6,F 12.6, ), ) 

150 WRITE (6,1150) (J,X2 ( J ) , SLCHN ( J ) , W ( J ) ,J S 1,NJ) 

1190 FORMAT ( ///1X37HWAKE DISPLACEMENT THICKNESS, /WAKETB///11X19HX2W/S1 
*W DST) 

WRITE (6,1190) 

UTAB = L WO 

CALL TABPRT(BLANK,X2W,LWE,2> 

1180 FORMAT! / / / 1 X4 3HTABLE OF FLOW ADJUSTMENT STATIONS, /C ADJ WF / / / 1 5X 3HX 
♦ 1 F 9 X , 3HX2FBX, 4HX1BF8X,4HXIAF9X, 3HS IF 8X , 4HNCHB8X, 16HNCHA JORDE 

*R ) 

WRITE (6,1180) 

UTAH = LFO 

CALL rABPRT( BLANK, XI F , LF E ,NFC OL S ) 

1160 FORMAT ( ///1X25HSTAT10N TABLE, /STATAB/ -> 

WRITE (6,1160) 

I1TAB = LO 

CALL TABPRT(BLANK,X1,LESTA,5) 

CALL JMSPRT 

1170 FORMAT ( ///1X19HFIELD COORDINATES -) 

WRITE (6,1170) 

CALL TABPRT ( 1HZ,2 ,NM, 10) 

CALL TABPRT ( 1HR,R,NM,10) 



c 


PRINT OVERALL DATA 
CALL T AflPR T ( 6HA L L C OM , MAC HA , 20 , 8 ) 


I F ( IGG0.6Q.2 ) 

l s top = 5 

GO TO (900,1777) 
900 RETURN 
END 


RETURN 
, L STOP 


h 



♦ DECK D8SRT 1 

SUBROUTINE DBSRTH F,M,INTR1, INTR2.A*N*II ) 

♦DBSRTi 

c date of this version - September 20,1965 

C SINGLE PRECISION DOUBLE BACK SUBSTITUTION SUBROUTINE USED WITH 
C LRMDSi SUBROUTINE To SOLVE SIMULTANEOUS EQUATIONS 
DIMENSION F ( I 1 , 1 ) ,A ( 1 1 , 1 I ) , INTR1I 1) 

NN = N 

NM 1 *NN- 1 
MM = M 

I F ( INTRl(l) ) 10*140*10 
10 IFINN.LE.II GO TO AO 
DO 30 K=l,NMl 

I 1*INTR1(K+1) 

I F ( I I J 15, 30, 15 
15 DO 20 J = 1 , MM 
X = FIK, J ) 

F ( K , J )=F( II, J ) 

20 F ( 11, J)=X 
30 CONTINUE 
AO DO 90 J = 1 , MM 
DO 80 L = 1 * NN 
I F ( F ( L , J ) ) 50,80,50 
50 F ( L » J )=F(L,J)/A(L,L) 

IF(L.EO.NN) GO TO 80 
DO 70 I =L , NM 1 
I F ( A ( I + 1 , L ) ) 60,70,60 
60 F<I+1,J)=F(I+1,J)-A(I+1,L)*F(L,J) 

70 CONTINUE 
80 CONTINUE 
90 CONTINUf 

IHNM.Lf .11 GO 111 1 AO 

loo no no .j = i,mm 

I F ( E ( NM 1 ♦ 1 , J ) ) 110,130,110 
110 DO 120 1=1, NM1 

120 F( I , J ) = F ( I , J ) - A ( I * NM 1+ 1 1 *F I NM 1+ 1 , J ) 

130 CONTINUE 
NM 1 =NM 1 - 1 

IF(NMl) 100*140*100 
1 AO RETURN 
END 


o o o o 


♦ DECK I SORT 

SUBROUTINE I SOR T < X , Y , Z ,B , LB , KGO ) 

CISORT C DC VERSION — MOVE COLUMN DATA TO ARRAYS 

COMMON /CBITS / BITS, BLANK 
DIMENSION X( I ) , Y(I),Z( 1) • BI1) 

INPUT- 

X , Y , Z = NEW COLUMNS OF DATA 

B = LOCATION OF COLUMN DATA TO BE RELOCATED 

LB = 3*COLUMN LENGTH 


K - 1 

I * I 

GO TO ( 10,30 ) , KGO 
10 I F ( B(I). EQ. BITS I GO TO 20 
X ( K ) * B ( I ) 

Y ( K ) = B( I ♦ I ) 

Z ( K ) = B( 1+2) 

20 I = 1+3 

K = K + l 

I F ( I . LT.LB ) GO TO 10 
GO TO 50 


30 I F ( B( D.EQ.BITS) GO TO AO 
X ( K ) = B ( I ) 

Y ( K ) = B(IU) 

40 I =1+2 

K * K + l 

I F C I. LT.LB) GO TO 30 
50 RETURN 
END 




♦DECK LOOP 

SUBROUTINE LOUP (A,H,C # N> 

♦ LOOP 

C THIS SUBROUTINE IS USED BY SUBROUTINE LRMDSi 
DIMENSION A ( 1 ) « B ( I ) 

DO 10 I = 1 » N 
10 A ( I ) = A t I I +B ( 1 >*C 
RETURN 
END 



♦DECK LRM0S1 

SUBROUTINE LRMDS 1 1 A , N , IN TR 1 , 1 NT R2 * DE T , I F AC TR , III ) 

♦LRHDS1 

C DATE OF THIS VERSION -- SEPTEMBER 20,1965 

C SINGLE PRECISION Lfcfl RIGHT MATRIX DECOMPOSITION SUBROUTINE 
C DETERMINANT = DE T* ( 2 . 0** I F AC TR ) 

C WHERE (.5) LESS THAN (ABS(DET)) LESS THAN OR EQUAL II. 01 
DIMENSION All), INTRl ( 1 ) 

I D I M* I I I 
NN=N 

NBASE=(NN-1 )*IDIM 
NTR = 1 

IF(NN.LE.l) GO TO 30 
DO 25 K=2 , NN 
INTRIIK )=0 
D = 0 .0 
M = K 

KM 1 =K - 1 
L = KM1 

JST0P=KM1+NBASE 
KBASE = (KM1-1 » ♦ I D I M 
KKM1-K+KBASE 

kk«kmi*kbase 

ISTOP=NN+KBASE 
DO 6 I = KK , I STOP 
B = A< I ) 

IKBASE*I-KBASE 

* 

* MODIFICATION TO SELECT THE PIVOT ELEMENT AS 1.0 IF PRESENT... 

* 

* DAVE FERGUSON 10/18/66 

* 

IFIB.NE.1.) GO TO 70 

0 = 1 . 

L= IKRASE 
M=!Kf)ASE 
GO TO 80 
70 CONTINUE 

* 

♦ 


IFIABS(B).LE.AUSIO) ) GO TO 3 
D*B 

L* I KB ASE 
3 IF(B)A,6,A 
A M= IKBASE 

6 CONTINUE 
80 CONTINUE 

KM=K-M 
KST0P=M-KM1 
I F ( D ) 8,7,8 

7 NTR=0 
INTR2=KM1 
GO TO 60 

8 LKM1=L-KM1 
IFILKMl) 10,17,10 

10 00 ii J=KM1, JSTOP, IDIM 
L J * J + LKM1 


tP' 


X = A( J ) 



A ( J ) = A C LJ ) 

11 A ( L J ) =X 

INTR1 (K )=L 
NT R = -NT R 
17 KK=KK*1D1M 

DO 22 I=KK, JSTOP, IDIM 
I F ( A ( I ) ) 19,22, 19 

19 A ( I ) = A( I)/D 
IF(KM) 20,20,22 

20 0= - A ( 1 ) 

CALL L OOP ( A ( Ml ), A(KKMl) ,0,KST0P> 
22 CONTINUL 
25 CONTINUE 
30 D=0.0 
KM 1 =NN 

KSTOP=NN+NBASE 
I F ( A ( K STOP ) ) AO, 7, AO 
AO I F AC = 0 
0 = 1.0 

ioimimdimm 

DO 55 K=1 .KSTOP, IDIMi 

IF( AB S ( A ( K ) ) . GE . 1 . 0 ) GO TO 51 

D = D*2 .0 

I F AC = IF AC- 1 

51 D=D*A(K) 

52 IF( ABS(D)-l.O) 53,55,5A 

53 D=D*2.0 
IFAC= IFAC-1 
GO TO 52 

5A D=D/2 .0 

I F AC = I F AC ♦ 1 

I F ( ABS( D) .GT. 1.0) GO TO 5A 
55 CONTINUE 

IFACTR= IF AC 
IF(NTR.EO.l) GO TO 60 
D=-D 

60 DET =D 

INTR1 ( 1 )=NTR 

RETURN 

END 




-REDBLK- 


♦ DFCK 
♦KEDBL 


R E UHL K 

BLOCK DATA R t DHL K 
K RED1NP BLOCK 

COMMON /SPACER/ M A XL H * 
COMMON /CLWQSV/ LWQSV 
COMMON /CTAPOS/ KESTR 
LOGICAL RES TR 

DATA MAXLH,MAXLT f MAXLF 
END 

OVERLAY! STC, 1, 1 ) 


DATA 

MAXLT, MAXLF, MAXLH 
T, ENDBDT,STCFIL,K6SV 

t,enobdt,stcfil 

,M A XL W/ 400, 200,200, 200/ 




• DECK ST CNR 

PROGRAM STCNK 
CALL KEOINP 
RETURN 
t NO 



oooono oooooooo 


♦DECK PEACES 

SUBROUTINE BF AC ES ( X , Y , ANG ,CUR V, E • S .KA ,KB ) 

♦BRACES BEAM FIT EVALUATION OF ANGLE, CURVATURE, -BFACES- 

C E AND S 

DIMENSION X( 10) ,Y( 10 ) , ANG ( 10 ) ,C URV ( 10 ) t E I 10 ) , S 1 1 0 > 

1NPUT- 

X , Y - COORDINATES 

ANG - ANGLE IN RADIANS (IF MA»i) 

ANG ( 1 ) - ESTIMATED ANGLE AT THE FIRST POINT <MA»0) 

K A, KB - FIRST AND LAST INOEX OF VARIABLES X, Y,ANG»CURV,E AND S 
KD - STORAGE INCREMENT OF X , Y , ANG ,CURV , E , AND S 
KORDER* 0 IF ERROR 1 IS TO BE CALLED WHEN PTS ARE OUT OF ORDER 
* NON ZERO IF RETURN IS TO BE MADE FOR CORRECTIVE ACTION 


OUTPUT- 

ANG 

CUR V - 

E 

S 

KORDE R = 


ANGLE IN RADIANS 
CURVATURE 

APPLIED FORCES * F/EI (UNITS ARE l./L**2) 

ARC LENGTH ALONG THE CURVE, (LI 

INDEX OF 2ND OF ADJACENT OUT-OF-ORDER PTS, N0T*0 ON ENTRY 


COMMON /CBEAM / MA ,MB , KD 

COMMON /ERASE / A ( 3 ) , B ( 1 ) , YPB ( 1 I , DA ( 1 1 , ACHD (1) ,CHD ( 793 I 


NK = KB 


CALL BEAM(X(KA) ,Y(KA ),ANG(KA I , ( KB-KA+KD > /KD > 

IF(KOROER.NE.O) GO TO 800 

C (K=KA) 

I » 1 

K = KA 

SK = S ( K » 

E(K> = 6.*(B( I I ♦ YPB ( I I ) / (CHD ( I ) ♦CHD (III 
C IK=KA,KB-1) 

60 C U R V ( K ) = <4.*B( I) +2. *YPB ( ID / (CHD ( I) ♦ ( I . ♦ i . 5*B( I) *B ( I ))) 
IF(KA-K) 65,80,80 
C (K=KA+1,KB-1 ) 

65 E ( K ) = 6 . * ( ( B ( I ) ♦ YPB ( I! )/ (CHD ( I I *CHD (II) 

1 - (B( 1-8 )♦ YPB ( 1-8) )/(CHD(I-8)*CHD(I-8) ) ) 

C (K=KA+1,KB) 

70 SK = SK + CHO( I-8)*(1. + (B( I-B)*Bl I-8)-.5*B( 1-8 )*YPB( 1—8' I ♦ 
1 YPB( I-8)*YPB( 1-8 ) 1/15.) 

S ( K J = SK 

IF(K-NK) 80,90,90 
BO I =1+8 

K = K+KD 

IF(K-NK) 60,70,70 


C ( K a KR ) 

90 CURV(K ) = (-2.*B( I-8)-4.*YPB( 1-8) )/(CHD( 1-8 ) ♦ ( 1 .♦! . 5*YPB ( 1-8 ) *YPB ( I 
18 ))) 

E ( K ) = -6. * ( B( I-8) + YPB( 1-8) )/(CHD(I-8) *CHD ( I -8) ) 

GO TO 900 


C OUT OF ORDER POINTS 

800 KORDER= KA+KORDER-KD 



*U0 RETURN 


6N0 




♦DECK ELLIP 

SURKIJUT INE ELL IP ( X 1 , Y L . ANGL , X2 , Y2 , ANG2 t ALPHAD > 

♦ELLIP CLLIP AND OTHER SMOOTH DUMMY SUBROUTINES 

C SUBROUTINE TO FIT AN ELLIPSE GIVEN TWO POINTS AND THE ORIENTATION 

ENTRY ELLIPT 

C SUBROUTINE TO FIT AN ELLIPSE WHOSE ORIGIN AND DIMENSION ARE GIVEN IN 
C A ROTATED AND TRANSLATED COORDINATE SYSTEM 

ENTRY XTRUNC 

C FUNCTION TO TRUNCATE XX TO AN EVEN MULTIPLE OF DX 
ENTRY ATDMR 

C SUBROUTINE FOR AUGMENTED TRIDIAGONAL MATRIX REDUCTION 
ENTRY BAD 

C SUBROUTINE TO DELETE BAD DATA BY ADJUSTING DATA LISTS 


ENTRY CUBER 

C SUBROUTINE TO CALCULATE YPP IN TERMS OF Y FOR CUBIC SPLINE EOUATIONS 
C WITH ARBITRARY END CONDITIONS 

ENTRY SMULTI 

C SUBROUTINE TO MULTIPLY TR IAD I AGONAL AND SQUARE MATRIX 

ENTRY HYPTS 
ENTRY HYPER 1 
ENTRY HYPER2 
RETURN 
END 



oooooooooo oooooooonoo 


♦ DECK 

♦ R6D- 


RBD 

SUBROUTINE RBD 

READ IN BOUNDARY DATA -RBD- 


INPUT- 

ENOBOT = END OF BDY/STC TAPE RECORDS, T OR F 

ENDCRO= END OF ALL STC CARD INPUT, T OR F 

K6SV = VALUE OF KE Y ( 6 ) OF LAST RECORD READ FROM TAPE 

RESTR1 = RESTART (WITH EXISTING TABLES) IS TRUE ONLY 

IF CARD BDY-DATA HAS NOT YET BEEN ENCOUNTERED 
STC F I L = T IF A STC-SUBFILE EXISTS ON T APE = ORGF. 
OUTPUT- 
ENDBDT= 

K6SV = 

RE STR T = 


INTEGER 

COMMON /BCOMMN/ 
LOGICAL 


REFS,BDY ,CHN 

PROGM ( 8 ) ,PROGSV,F 1 L I N, F I LOT , REFS ( 5 ) 

F ILIN,FILOT 


COMMON /ALLCOM/ 

1 

2 

REAL 

LOGICAL 

BOUNDARY TABLE 


MACHA,PSA,TSA,PTA,TTA, AX I A , RGA, G AMA , 
MACHC.PSC ,TSC ,PTC t TTC, AXIC ,RGC, GAMC, 
DA X IT, SC ALE A, TTE,CHOTST 
MACHA ( I ) , MACHC 
AXIA,AXIC , C HO T S T 


INDEX- LB=LBDO»LBDE 

LBNEXT= INCREMENT TO NEXT BOUNDARY 

LB2I = INCREMENT TO THE FIRST BOUNDARY POINT <*0 BEFORE COALLATIO 
CHNAME= CHANNEL WITH WHICH THE BOUNDARY DATA IS ASSOCIATED 
UP = T OR F FUR UPPER OR LOWER BOUNDARY 

LEDEX = RELATIVE INDEX OF L.E. POINT WHEN LOWER AND UPPER SURFACE 
CONTOURS ARE CONNECTED 

BONAME,LBA,LBB=NAME AND INDEX LIMITS OF SPECIFIC BOUNDARY 

DATA WHEN BOUNDARIES ARE COALLATED 
COMMON /CHDATA/ BDT ( 1) ,LBNEXT(i),LBZl(l) , 

1 CHNAME ( l ) »UP ( i ) , LEDE X ( 1 ) , 

2 ZHT(1),RB1(1) , ANGB T I 42 ) 


LOGICAL UP 

INTEGER BDT, CHNAME, BDNAME 


DIMENSION 
EQUIVALENCE 
COMMON /IXORIG/ 


* 

* 

* 


DIMENSION 

EQUIVALENCE 

COMMON /ADAM02/ 
LOGICAL 

COMMON /CBITS / 
COMMON /CLINES/ 
LOGICAL 

COMMON /CNTRL / 
EQUIVALENCE 
COMMON /CPI / 
COMMON /CREDIN/ 


BDNAME ( 1 I , LB A ( 1 ) , LBB ( I I 

(BDNAME, ZBT) , (LBA,RBT), ( LBB , ANGBT ) 

LHO, LHE , LBDU »L BDE , LTO,LTE, LWO,LWE, LFO,LFE, 
LO.lESTA, LUUM ( 8 ) , 

MO ,NM, NJ,NFCOLS, MAXNJ,MAXOL,MAXNM,MAXLE, 

LEO, LEE, LRO,LRE,LRD 
L I MI TS ( 24 ) 

(LIMITS, LHO) 



ENDJOB ,NUMPL T ,PLOTED »ENDCRD 
ENDJOB, PLOTED »ENDCRD 

BI TS , BLANK 

LINES, 0MITFK,PTITLE(6) 

OMI TFK 

K5,BDYI6 ) , INSf R T, CARRY, CHN 
( BDY , IBDY) 

PI , T WOP I ,PIQ2,PIQ4,T00EG,T0RAD 

/ TRANS, RTRA NS, ROTATE, /PIVOT, RPIVOT, SCALE, NB,FAB(9) 


MJUI VALENCE 

1 

COMMON /CTAPOS/ 
LOGICAL 

COMMON /ERASE / 
COMMON /SPACER/ 
COMMON /TROUBL/ 
LOGICAL 


( X TRANS# Z TRANS I , ( VTRANS# RTRANS ) , ( XP I VOT , Z P I VOT ) , 
( YP I VOT « RPI VO I ) 

R I STKT,EN0HDT,STCFIL,K6SV 
KhSTRT f t NDBDT ySTCF !L 
B( BOO) 

M AXLH , MA XLT , MAXLF , MAXLW 

fcRR*ERRMAJ»INERR»PRERR 

ERR»ERRMAJ»lNbRR#PRERR 


C 


SMOOTH COMMONS 
COMMON /ADAMOl/ 
COMMON /CALCPT/ 
COMMON /CELLPT 
COMMON /CSEGME/ 
l 

LOUI VALENCE (N 
COMMON /CSMOOA/ 
COMMON /CSMOOB/ 
DIMENSION 
EQUIVALENCE 
COMMON /CDS2 / 

1 

DIMENSION 

EQUIVALENCE 


NAME (6), 
DX.XMOD 
/ DZETA 
I A ( 1 0 ) y I 
N I I # N I M 
• Nil ) 
DEVA(20) 
XA ( 100 ) • 
ZA(IOO), 
(ZA, XA), 
X( 100) ,Y 
FQM 100) 
Z ( 100) yR 
{ Z y X ) y (R 


ADORES! 6) y TITLE (6) • I DENT (6) 


B(10) ,IMA( 10) y I MB (10) , JTYPE ( 10) ,N,NSEG, 


y EENDA ( 20 ) , ANGA ( 20 ) yCURVA(ZO) yNARB 
YA(lOO) , DEVI (100) 

RA< 100) 

(RA f YA) 

( 100) yANG( 100) y ANGD( 100) , CURV ( 1 00 ) , S ( 100 ) 
, DEVI 100) ,CURVB( 100) 

( 100) yDUM(lOO) 
y Y) y ( DUMyCURVB) 


f 


LOGICAL DAT A IN • ENDBDC y UP PER y ZRONLY 


DATA KBDY/3HBDY/, KHIGH/6H / 


NAMELIST /A/ 

By 

NB, 

TAB, 

DBLPTS, 

ZRONLY 

1 

BDY, 

CHN, 

UPPER, 

x,z, 

Y,R» 

ANGD 

2 

ROTATE, 

ZPIVOT, 

RPIVOT, 

ZTRANS, 

RTRANS, 

SCALE 

3 

FLIP, 

XP I VOT y 

YPI VOT, 

XTRANS, 

YTRANS , 

DUM 

A, 

IDENT, 

DX, 

XMOD , 

DEVA, 

FENDA, 

ANGA 

5 

CURVA, 

Z AyXAy 

RA,YA, 

DEVI, 

N I I y 

DEV 

6 

AN Gy 

CURV, 

CURVBy 

FQK, 

s. 

NIM 


7 UPPER 

C DEFINTE DOUBLE POINT TOLERANCEy DPTOl 
DPTOL = l.E-5 


C 

C 


C 


INITIALIZE 

ENDBDC* END OF BDY CARD INPUI, T OR F 
ENDBDC* .FALSE. 

IF(K5.NE.KBDY .OR. ENDCRD ) ENDBDC* . TRUE. 
15 DATAIN* .FALSE. 

DBLPTS* .01 
JFOUND= 0 

READ BDY INPUT CARDS 
35 I F ( ENDBDC ) GO TO AO 
FLIP * 1. 

ROTATE * 0. 

ZPIVOT* 0. 

RPIVOT* 0. 

SCALE * SCALEA 
7 TRANS* 0. 

R TRANS® 0. 

ZRONLY® .FALSE. 




CALL SETM(l».lv DEVI, 100) 

CALL SETM ( 3,BITS,XA,200,OEVA»«0,B,300) 

CALL SETM I 1, BITS, X, 2 00) 

READ (5, A) 

IF(ZRONLY) CALL I SOR T ( XA , YA ,OUM , B , 200 , 2 ) 

I F { . NOT .ZRONLY ) CALL I SOR T I X , Y, ANGD , B , 300 , 1 ) 

I F ( .NOT.ZRONLY) CALL ISORT(X,Y,ANGA, B ,300 ) 

IF(INERR) ERRMAJ=. TRUE. 

DAT A I N = .TRUE. 

RE STR T= .FALSE. 

C COUNT THE LENGTH OF THE Z-LIST 

40 I F ( .NOT .DAT AIN) GO TO 900 

I F ( J FOUND • EQ • 1 ) GO TO 43 
N I =0 
DO 41 1=1,100 

I F ( X A ( I ) .EQ.B1TS) GO TO 42 

41 N I = I 

42 I F ( N I .EQ. 0) GO TO 43 
LlNtS = 64 

CALL SMOTH 
JFOUNO= 1 

43 NZ =0 

DO 45 1=1,100 
I F ( Z ( I ) .EQ.BITS) GO TO 50 
45 NZ = I 
50 I F ( NZ -2 ) 55,100,100 
55 WRITE (6,1055) BDY(l) 

ERRMA J= .TRUE. 

RETURN 

C DELETE DOUBLE POINTS FROM SMOOTH BOUNDARY RECORDS 
100 OM I TF K = .TRUE. 

CALL FHEADINZ+IO) 

WRITE (6,1090) IBDY,CHN, UPPER 

IF (JFUUND.NE.l .OK. DBLPTS.EO.O. .OR. NZ.LE.2) GO TO 150 
WRITE (6,1100) DBL PT S , DBL PTS 
I = 1 

110 I = I+l 

I F ( I.GT.NZ) GO TO 150 
I F ( ABS(Z( I J-Z( 1-1) J.GE.DPTOL .OR. 

1 ABS(R( I )-R( 1 — 1 ) I.GE.DPTOL) GO TO 110 
ANGD I F= ABS( ANGD( I l-ANGD ( I-i ) ) 

IF (ANGDIF.GE.DBLPTS) GO TO 110 
NMOVE = NZ-I 

ANGSV = . 5* ( ANGD( I )+ANGD( 1-1) ) 

IF( ANGD( I )*ANGD( I-i) .EQ.O. .AND. ANGDI F . LE . .0005 ) ANGSV=0. 
ANGD( I- 1 ) =ANGSV 

CALL MOVE ( 3 , Z ( I + 1 ) , Z ( I ) , NMOVL, 1 , 

1 R( I+l ),K( I ) , NMOVE, 1, 

2 ANGDI I ♦ 1 ) ,ANGD( 1 ), NMOVE, 1) 

NZ = NZ- 1 

GO TO 110 

C CALCULATE CURVATURES FOR PRINTOUT 
150 I =1 

CURV ( 1 )=0.0 
155 CUR VB ( I ) =B I TS 



noo oooooooooooooo 


cur v ( i+1)=curv( i ) 

DX = Z ( 1*1 )-ZI I ) 

OV = R( I 41 )-R( II 

CHI) = SQRT( DX*DX+DY*DY ) 

IF ( CHU.LT . .00001 ) GO TO 160 
ACHO * ATAN3(0Y,()X, ANGD ( II* FORAO) 

YPA = ANG{ I ) * T0RA0-ACH0 

YPB = ANGOI I ♦ 1 ) * TOR AO- ACHO 

CURVB( I )»(4.*YPA+2.*YPB) /(CHDM l.*1.5*YPA*YPA) ) 

CUR V ( I+i)*(-2.*YPA-4.*YPB)/ICMD*<l.+1.5*YPB*YPB) > 

GO TO 165 

160 IF( I.EQ.i ) GO TO 165 

IF (CURVBI I-n.EQ.BITS) C URVB ( I - 1 )*CURVB( 1 ) 

165 I * I+l 

I F ( I.LT.NZ) GO TO 155 
CURVBI I )»0.0 

♦REL013 RELOCATE FROM A ONE TO A THREE DIMENSIONED ARRAY -REL013- 

C SUBROUTINE REL013 

INPUT- 

Z,R = BOUNDARY COORDINATES 

ANGD = ANGLE OF THE BOUNDARY (DEGREES) 

NZ x NUMBER OF BOUNDARY COORDINATE POINTS 

FLIP = SCALER ON RII) BEFORE ROTATION OR TRANSLATION 
ROTATE* ANGULAR ROTATION IN DEGREES 

ZPIV0T,RPIV0T*PIV0T POINT FOR ROTATION BEFORE SCALING 
SCALE * MULTIPLICATIVE CONSTANT ON INPUT COORDINATES 
ZTRANS* Z-TRANSLATION AFTER SCALING 
RTRANS* R-TRANSLATION AFTER SCALING 
BDY * BOUNDARY NAME 

UPPER = T IF UPPER BOUNDARY, = F IF LOWER BOUNDARY 
CHN = CHANNEL NAME 

LBDE * NEXT AVAILABLE LOCATION IN THE BOUNDARY TABLE 
OUTPUT- 

BOT = TABLE OF Z »R , ANG IN 3-D ARRAY FORM 

LBDE = NEXT AVAILABLE LOCATION IN THE BOUNDARY TABLE 

IF I FL IP.NE. 1. .OR. ROTATE. NE.O. .OR. SCALE. NE.l. .OR. ZTRANS.NE.O. 

1 .OR. RTRANS.NE.O. ) WRITE 16,1151) F L I P, ROT ATE »Z P I VOT , RP I VOT . 

2 SCALE, ZTRANStRTRANS 
WRITE (6,1152) 

LB1 * LBDE 

L 82 * LB1 + 3* ( NZ- 1 ) 

LB * LBl 

BDT(LB)=BDY 
CHNAME ( LB ) =CHN 
LBZ 1 ( LB ) “0 
UP ( LB ) * UPPER 
LEDEX ( LB ) *0 
I = 1 

LBDEL = 3 
ADDPI = 0. 

I F ( .NOT. UPPER) GO TO 240 
LB = LB2 
LBDEL * -3 
AOOPI = PI 

240 ROTAT * ROT ATE*TORAD 







SN = SIN(ROTAT) 

CS = CDS ( ROT AT ) 

2 ">0 IF(ROTATE.NE.O. ) GO TO 260 
ZBT ( L B ) = Z ( I ) * SCAL E + ZTRANS 
RBT ! L B ) =R ( I )*FL I P* SCALE ♦ RTRANS 
GO TO 270 

260 RFLP = R ( I )*FLIP 

ZBT(LB)=(ZPIVOT+CS*<Z( II-ZPI VOT ) -SN* < RFLP-RPI VOT ) I ♦SCALE ♦ ZTRANS 
RBT (LB) = (RPI VOT +CSMRFLP-RPI VOT l +SN* ! Z ( I ) - ZP I VOT )) ♦SCALE ♦ RTRANS 
270 ANG1JI I l=ANGD( 1I*FL IP + RUT A 1 1 
ANGB f ( LB ) = ANGD( I ) * TO RAD ♦ AOIJPl 

WRITE (6»12H0) I , Z BT { LB ) , RBI I LB ) , ANGD ( I ) , CURV II ) , CUR VB ( I ) 

I F ( I.GE.NZ ) GO TO 300 
I =1 + 1 

LB = LB+LBOEL 

GO TO 250 
300 LBDE = LB2 + 9 

LBNEXT I LB1 )=LBDE-LB1 
BDT (LBDE )= BLANK 
C END SUBROUTINE REL013 


900 RETURN 

1055 FORMAT ( //1X43H** NO COORDINATE INPUT WAS FOUND FOR BDY=A6,//I 
1090 FORMAT! ///IX, 45HH OUNDARY COCRDINATES. BDY=A6, 

♦ 5X4HCHN=A6, 5X6HUPPER= 

*L 2 * ) 

1100 FORMA T ( /6X46HD0UHL E POINTS WITH ANGLE DIFFERENCES LESS THANF6.3,lX 
♦24HAME ELIMINATED ( DBLP T S=F 5 • 3 * 2H ) • ) 

1151 FORMAT ( /6X5HFL IP=f 7 . 3 , 3X 7HR0 T AT E *F 8 . 3 , 3X7HZ P I VOT * F 10 . 5 , 3X7HRP I VOT * 
*F U .5 , 3X5HSCALEF 7.3, 3X7HZ TRANS=F 10.5, 3X7HRTRANS=F 10.5, ) 

1152 FORMAT / 9 X *»8H l X,Z Y , K ANGD CURV- CURV+ ) 

12 80 FORMAT! I 10, 2F 10.5, F 10.3, 2F 10. A > 

END 


♦DECK CRBD 

BLOCK DATA RBOBLK 

♦CRDD-- BLOCK DATA F (JR RDD ROUTINE -CRBD- 

♦SMOBLK SMOOTH BLOCK COMMON -SMOBLK- 

COMMON /CSMOUD/ SGAMMA , SZETA 1 ,$ZE TAN 
DATA SGAMMA, SZETA1 .SZETAN/ 1 . , 1 .E2, I.E2/ 

END 




non no non noon 


♦DECK RCD 

SUBROUTINE RCD 

♦RCD READ IN CHANNEL OATA -RCD- 

INPUT- 

CHDATA- CHANNEL INPUT DATA TABLE 

LHE = NEXT AVAILABL LOCATION IN CHANNEL INPUT DATA TABLE 


OUT PUT- 

LCHE = NEXT AVAILABL LOCATION IN CHANNEL INPUT DATA TABLE 
CHDATA- CHANNEL INPUT DATA TABLE INCLUDING NEW INPUT VALUES 


COMMON 

LOGICAL 

COMMON /CBITS / 
COMMON /CNTRL / 
INTEGER CHN 
EQUI VALENCE 
COMMON /CTABPR/ 
COMMON /CTAPUS/ 
LOGICAL 

COMMON /SPACER/ 
COMMON / T ROUP L / 
LOGICAL 


PROGM ( 8 ) , PROGSV.FI LIN, FI LOT, REFS (5) 

FILIN, PILOT 

BITS, BLANK 

KS, CHN (6), INSERT 

( I CHN , CHN ) 

1 1TAB 

RESTRT .ENDBDT ,ENDFIL,K6SV 
KE STRT, ENDBDT ,E NDF I L 
MAXLH.MAXLT.MAXLF ,MAXLW 
ERR, ERRMAJ, INERR, PRERR 
LRR.ERRMAJ, INERR,PRERR 


CHANNEL INPUT DATA TABLE 


1 

2 


INDEX- LH=LHO , LHE 

COMMON /CHDATA/ C HNAM ( I) , LHNE XT (I) , WTF LOW (I) ♦ TTO (I) , PTO ( I ) 

TSOm.PSOdl , MACHO! I »,AOU», VARY m, 

RG(I ) ,GAM(1) , NR( 1 ) ,NC(1 I ,TAB(6) , 


, 


4 


B B ( 75 ) 


LOGICAL VARY 

INTEGER CHNAM 


DIMENSION 

REAL 

EQUIVALENCE 
COMMON /IXORIG/ 

* 

* 

* 

DIMENSION 

EQUIVALENCE 


VOID 
MACHO 
I VO, MACHO) 

L HO, LHE , LBDO.LBDE, LTO.LTE, LWO.LWE, LFO.LFE 
LO.LESTA , LDUM18), 

MO ,NM , NJ.NFCOLS, MA XN J , MAXOL ,MAXNM, MAXLE , 

LEO, LEE, LRO , LRE , LRD 

LIMITSI24) 

( L IMI TS, LHO) 


COMMON /ERASE 


UUMI 16 ) « H ( 7 84 ) 


NAMELIST /A/ CHN , W TF LO W, T TO , T I , PTO , PT , 

1 TSO,PSO, MACHO, AU, VARY, 

2 GAM.RG, 

3 NR ,NB , TAB ,B 



RESTART CASE WITH CHANNEL FLOW DATA REVISIONS 
RELOCATE CHDATA FOR CHANNEL=CHN INTO FIRST POSITION 
FIRST FIND INDEX LH FOR CHNAM=CHN 
LH = LHO 

12 IFILH.GE.LHE) GO TO 20 

IFICHNAM(LH) .EQ.CHN) GO ID 14 
LH = LH+LHNEXT ILH) 



GO TO 12 

14 IF(LH.EG.LHO) GO TO 16 
LNG = LHNEXT(LH) 

L HI a LHO+LNG 

LH2 = LH+LNG 

LH3 * LH2+LNG 

CALL MOVE ( 3 » CHNAM ( LHO I f CHNAM ( LHl ) f LHO-LHE -1 1 1 « 

1 CHNAMILH2I ,CHNAM(LHO» ,LNGtl t 

2 CHNAM (LH3)» CHNAM (LH2 ) ,LHE+LNG-LH3+l , 1 ) 

16 LHNXT * LHO + LHNEXTUHO) 

GO TO 30 

20 CALL MOVE! It CHNAM , CHNAM ( 21) t LHO-LHE-l , 1 ) 

LHNEX T * 20 
LHNXT = 21 

L HE * LHE+20 

C INITIALIZE 

CALL SETMC ifBlTStWTFLOWtlO) 

VARY = .TRUE. 

C READ CHN INPUT CAROS 
30 CALL SETMIltBITS, B.400) 

READ (5, A) 

IFIINERR) ERRMA J» . TRUE . 

C RESET CHNAM IF CHANNEL NAME HAS BEEN REDEFINED 
CHNAM * CHN 

C COUNT THE LENGTH OF THE B-ARRAY 

NR « 0 

NCI * NC 

DO 40 I *1 f 400 »NC1 

I F ( B ( I ) .EQ.RITS ) GO TO 50 
40 NR * NR ♦ 1 

‘>0 NCR * NC*NR 

C RELOCATE AND INSERT B-ARRAY INTO CHDATA-TABLE 

IF ( NCR.EQ.O ) GO TO 950 

LHNXT T * LH0 + 20+NCR 
NMOVE a LHE-LHNXT ♦ 1 
IF! LHNXTT.GT. LHNXT) NMOVE=-NMUVE 

CALL MOVE ( 2 1 CHNAMILHNXT I tCHNAMILHNXTT) ,NMOVEtlt B,BB,NCRrl) 

L HE » LHE+LHNXTT-LHNXT 
LHNEXTa 20+NCR 

950 IF(LHt.LT.LBOO) GO TO 9B0 

WRITE I 6 * 1960 ) LHO ,LHE ,MAXLH . LBDO 
CALL ERROR 1 
9B0 RETURN 

1960 FORMAT ( /1X81H*** THE CHANNEL INPUT DATA TABLE HAS EXCEEDED ALLOTT 
*ED MEMORY. INCREASE MAXLH. /6X4HLH0* 1 4 ,3X4HLHE= 1 4 1 3X6HMAXLH= 1 4 , 3K 
*5HLB00a 14$ ) 

END 

1 b 



ooooooooooooo 


♦ DECK 


RED INP 
SUBROUT INE 


REDINP 


♦REDINP 


STC READ INPUT 


-REDINP- 


COMMON /BCOMMN/ 
LOGICAL 

COMMON /ADAMO 1 / 
COMMON /ADAM02/ 
LOGICAL 

COMMON /ALLCOM/ 


1 


REAL 

LOGICAl 

LOGICAL 

LOGICAL 

REAL 

EQUIVALENCE 
COMMON /CSS 


1 


INTEGER 
LOGICAL 
SSFML = 
SSEF = 

sseang= 

SSDF = 

S S F E N D = 

S S F NO I = 
SSDLE = 
AAF AC T = 
BWLX 
CUR RL X = 
PHOC 

RHOCS S = 
COMMON 


* 

* 

* 


PROGM ( 8 ) ,PROGSV,FlLIN,FlLOT 

F I L I N»F I LOT 

NAME ( 6 ) , ADDRt S(6)»TITLE(6), I DENT ( 6 ) 

E NDJOB , NUMPL T * P LOT ED » E NDCRD 
ENDJOB, PLOTED »ENDCRD 

MACHA,PSA,TSA,PTA»TTA, AX l A , RGA, GAMA , 
MACHC»PSC»TSC»PTC*TTC» AX I C » RGC , GAMC * 

DA XI T,SCALEA,TTE,CHOTST 
MACHA(l) « MACHC 
AX I A , A X I C 
CHOTST 
AX I 

MACHO(l) 

(MACHO, MACHC ) , I PSOtPSC ) , ( TSO, TSC ) , < PTO, PTC ) , 

( TTO, TTC ) , ( A XI ,AXIC ) , (RG,RGC ),( GAM, GAMC) 
SSFML,SSEF,SSEANG,SSDF,SSFEND,SSFNDl 
, SSDLE, A4F ACT, BRLX ,CURRLX , TS I C , RHOC t RHOCSS 
SSFML 

SSEF, SSDF, SSDLE 

SUPERSONIC CURVATURE FORMULA NUMBER 
SUPERSONIC ENTERING FLOW, T OR F 
ENTERING FLOW ANGLE (DEGREES) FOR SSEF*T 
SUPERSONIC DISCHARGE FLOW, T OR F 

SUPERSONIC BEAM DOWNSTREAM END CONDITION, *0,1 FOR PARABOL 

SUPERSONIC BEAM UPSTREAM END CONDITION, *0,1, FOR PARABOLA 

SS FLOW BELOW AND AFT OF LE PT, T OR F 

CENTRAL POINT INFLUENCE COEFFICIENT FACTOR 

B-RELAXATION FACTOR 

CURVATURE RELAXATION FACTOR 

ACCELERATION FACTOR UN CURVATURE ITERATION AT 
SUBSONIC POINTS 

ACCELERATION FACTOR ON CURVATURE AT SUPERSONIC POINTS 
/IXORIG/ LHO, LHE , LBDU ,LBDE , LTO.LTE, LWO,LWE, LFO»LFE , 
LO.LESTA, LDUM ( 8 ) , 

MO »NM, NJ.NFCOLS, MAXN J, MAXOL .MAXNM, MAXLE • 

LEO, LEE, LRO , LRE , LRD 
L I M I TS ( 2 A ) 

(LIMITS, LHO) 

W( I28),X2(128),SLCHN(128) 


DIMENSION 
EQUIVALENCE 
COMMON /SLTA8 / 
INTEGER SLCHN 
COMMON /BENDIN/ 
COMMON /CB / 
COMMON /CBITS / 
COMMON /CCRX / 
DIMENSION 
EQUIVALENCE 
COMMON /CHDATA/ 
COMMON /CENU / 
COMMON / C 1 A D I N / 
COMMON /C INNER/ 
COMMON /CISBOT/ 


1 


INTEGER 

COMMON /CLINES/ 


NBC I N ( 2 ) , ACF ( 2 ) 

B( 300) 

B I TS, BLANK 

CRXSL,CRXOL,CRXSS,CRXE,CRXC,CRMACH 
C R X ( 6 ) 

(CRX,CRXSL) 

TABLESI20A6) 

T BLEND ( 2 ) 

R HOB AS ,RHOAMP , I ADM 
INRCTR,R0UM,N INNER! 16) ,CNVF(16) 
FARFLD(2 ) ,FREE( 2) ,PRES(2) ,RFF,NZP, 
ZP( 10) ,PPS(1Q), A I , A2 , ADUM ( 6 ) 
FARFLD, FREE, PRES 
LINES, OMI TFK,PTITLE(6) 




n i > 


COMMON /CLWOSV/ LWOSV 
COMMON /CM / JM S ( 300 ) 

COMMON /CMAXIT/ M A X I T , MA JCTR , GREF I N , EDUM 
LOGICAL GREFIN 

COMMON / CNORM / RHL ,RM t AHL , ARM 
COMMON /CNTRL / K f> ( l ) f S T A ( 6 ) ( INSERT 

COMMON /CPRINT/ PRTE S2.PRTB ,PRTA, PREFI N, PREFN2 .SSONIC ,PDUM< 20 ) 
COMMON /CPRPRN/ PRPRN 
INTEGER PRPRN 

COMMON /CPTMOV/ VELPOT, ICOB, NODENS ,F BASTG 
LOGICAL VELPOT 

COMMON /CR / RF ( 300 ) 

COMMON /CREF1N/ SL S, SG21 , VMG1 ,VMG2 , NGR, NGZ , SGR( 1 0 ) , GR( 10 ) , 

I SGZ( 10) ,GZ( 10) 

COMMON /CS1 / SI (300) 

COMMON /CS2 / S2 ( 300 ) 

COMMON /CTAPOS/ RE STR T , E NDBD T , S TCF I L , K6SV 
LOGICAL RESTKr »ENUBDT , S TCF I L 

COMMON /CTHICK/ N THK X , NT HKY , THK X ( 20 ) , THKY ( 20 ) , TH I K2D < 78 > 

COMMON /CTOLRL / TOLRL ,MA XSWP ,CLEN , DS2MX , T OLE S2 , NS WP, 

1 DS1DMP,DS1MXA,DSIMXB,DS1RMS,ES2MX 

♦ ,DS1RMO.SG1MIN»TOLINR 

COMMON /CVM / VMF ( 300 ) 

COMMON /CZ / ZF ( 300 ) 

COMMON /SPACER/ MAXLH.MAXLT, MAXLF » MA XLW 
COMMON /TROUBL/ ERR , ERRMA J , I NERR , PftERR 
LOGICAL ERRtERRMAJt INERR»PRERR 

COMMON /TAPES / NTAPO.NTAPN 


LOGICAL FIRST 

DATA KA/1HA/, KBDY/3HBDY / « KCHN/3HCHN/, KSTA/3HSTA/ 
DATA FIRST/. TRUE./ 


C ENDCRD* T IF END OF CARD INPUI 

C ENDBDT 3 T IF END l)F HOUNOARY DATA ON TAPE 

C STCF I L * T IF A STC-SUBFILE EXISTS ON TAPE*ORGF. 


NAMELIST /A/ IDENT, AXl, RG.GAM, MACHO, PSO.TSO, PTO,TTO, PRPRN, 

1 INRCTR,TTE,CHOTST, MAXI T ,MAJC TR ,NI NNER .VELPOT, I COB, NODENS, RN 

2 VMG1.VMG2. NGR, NGZ, SGR ,GR, SGZ.GZ, SLS.SG21, 

3 NBCIN ,ACF , SSFML ,SSEF , SSEANG, SSDF ,SSFEND,SSFNDI . 

A SSDLE, A4FACT, BRLX, CURRLX, TSIC, RHOC, RHOCSS, 

5 FARFLD.FREE ,PRES,RFF,NZP,ZP,PPS,A1, A2.ADUM, 

6 LIMITS, TABLES, B , JMS , SI , S2 , ZF , RF , VMF , W.X2.SLCHN, 

8 TOLRL, MAXSWP,T0LES2,T0L1NR,SG1MIN,DS1DMP,DS1RM0, 

9 CRXSL ,CRXOL ,CRXSS,CRXE ,CRXC,CRX, 

* PRTES2,PRTB,PRTA,PREFI N» PREFN2 »S SQNI C. PDUM, 

* MAXLH.MAXLT , MAXLF , MAXL W , KEYB , RDUM , CNVF, 

* PLOT, IPLOT, SAME X Y, XSCALE»YSCALE, 

RHOBAS, RHOAMP, I ADM, 


NTHKX,NTHKY,THKX,THKY,THIK2D, 
LBL , MAXLBL , TOLLBL 



* 


C«* INITIALIZE AND RFAI) OVERALL (A) INPUT DATA 

IF( .NOT. FIRST .AND. (K5.NE.KA .OR. ENDCRU)) GO TO 200 
IFIFIRST .AND. K5.EQ.KA) GO TO 100 



WRITE (6,1000) 

ERR = .TRUE. 

PROGS V= 0. 

GO TO 200 

100 PROGS V = 0. 

END8D T = .FALSE. 

FIRST = .FALSE. 

LINES = 64 

MAJCTK= 0 

RE S TR T = .TRUE. 

STCFIL= .false. 

CALL SETM(l,lUTS, MACHO, 8) 

C DETERMINE FIELO ARRAY SIZE 

MAXLE = L0C2I TABLES, TBLEND) 

MAXNM = L0C2(RF,ZF) 

GO TO 120 

C READ CARD INPUT 
130 READ ( 5, A ) 

DO 135 1=1,8 

135 IF ( MACHO( I ) .NL.BI TS) MAC HA (I ) =MACHO( I ) 
DATA AOOOOO/6HAOOOOO/ 

K6SV = AOOOOO 


C DEFINE THE CHARACTERISTIC LENGTH, CLEN 
CLEN = SGR 

IF(NGK.LE.l) GO TO 146 
DO 144 1=2, NCR 
144 CLEN = CL EN + SGR ( I ) 

146 IF(NGZ.LE.O) GO TO 149 
DO 148 1=1, NGZ 

148 CLEN = CL EN + SGZ ( 1 ) 

149 CLEN = CLEN/FLOAT (NGR+NGZ) 


C 

c 

c 

c 

c 

c 

c 

c 


c 


SET UP INDEX-ORIGIN TABLE IF THERE 
ORDER OF TABLES IN BLOCK COMMON 

LH /CHDATA/ 

LB / BDY TAB/ 

LT /CONVTB/ 

LW /WAKETB/ 

LF /CADJWF/ 

L /STATAB/ 

IF(STCFIL) RETURN 
R E S TR T = .FALSE. 

LBDO = LHO+MAXLH 
LBDE = LBDO 
(OTHER INDEX LIMITS ARE 
RETURN 


IS NO STC-TAPE INPUT 


SET IN SUBROUTINE BLDTBS ) 


C READ INPUT FILE 

120 IF( .NOT. FILIN) GO TO 130 
REWIND NTAPO 

READ (NTAPO) STCF IL , ( L I M I TS ( 1 ) , I =1 , 24 ) 
LWOSV = L WO 
IF(STCFIL) GO TO 125 
ENDBD T= .TRUE. 


WRITE (6,1120) 

GO TO 130 

12b READ ( N r APO ) ( ( I Dfc N f ( I) , 1 = 1 , 6 ) , A X 1 , RG , GAM , MACHO, PSO , T SO , PT 0 , T T 0 , 

1 PRPKN,TTE*CHOTST,MAXlT , MA JC TR » ( NI NNER ( I > , I *1 , 16 ) , VELPOT.ICOB, 

2 N0DENS,RN,NGR ,NGZ, ( SGR < l ) ,1 =1 ,40) , VMGl , VMG2 , INRCTR, SLS.SG21, 

3 NBC 1 N ( 1 ) , NBC I N ( 2 ),ACF( 1 ) ,ACF (2) , SSFML , SSEF , SSE ANG, SSDF ,SSFEND, 

4 SSFND1, SSDLE, A4FACT,BRLX,CURRLX,TSIC, (FARFLDd ) ,1*1,8), 

* RHGC , RHOCSS , RHL » RM, 

5 (ZP( I ), 1 = 1,28), ( TABLE S ( I ) ,I = 1,LESTA) , ( B ( 1 ) , I = 1 * NM ) , (JMS(I), 

6 1 = 1, NM), (Sl( I),I = 1,NM), (S2(I),I"l,NM) , (ZF(I) ,1*1, NM) , f RF Cl), 

7 1*1, NM), ( VMF (1 ) , I =1 ,NM ) , ( W( I ) , I = 1 ,N J ) » ( X 2 ( I ) , 1 = 1 , N J ) , 

8 ( SLCHN ( I ),I=1,NJ),T0LRL,MAXSWP,T0LES2,T0LINR,SG1MIN,DS1DMP, 

A DS1RM0, (CRX( I ) , 1=1,6) , RHOBAS , RHOAMP , I ADM , NTHK X , NTHKY , 

B (THKXd ), 1 = 1,118) ) 

C CHECK TO SEE IF STC-A INPUT DATA EXCEEDED DIMENSIONS 

IF(NM.GT.L0C2(RF,ZF) .OR. LE S TA .G T . L0C2 ( T ABLE S , TBLEND ) ) ERR= • TRUE . 
GO TO 130 

C READ BOUNDARY DATA 

200 CALL KBD 

IF(ENDCRD) GO TO 700 
I F ( K5.EQ.KBDY ) RETURN 

C READ CHANNEL DATA 

300 IF(K5.NE.KCHN ) GO TO 400 

C IF RESTRT, UNPACK TABLES TO MAKE ROOM FOR NEW CHDATA AND CONVTB. 

IF ( .NOT .RESTRT .OR. LBDO.GT. (LHE+1 ) ) GO TO 350 
MOVE 1 * L0C2(TABLES,S1)-LESTA 
MOVE 2 = MOVE 1/2 
LWTO * LWO+MOVEl 
LBTO * LBD0+MQVE2 

CALL MOVE ( 2 , T ABL ES < L WO ) , T ABLE S ( L WTO ) , L WO-LE STA- 1 , l , 

1 TABLES ( LBDO ) , TABLES (LBTO) ,LBDO~LTE -l, 1 ) 

LBDO * L BDO + MOVl 2 
1. TE * L T E ♦MOVE 2 
LBDE * L BDF ♦MOVE 2 
LTD = L TO+MOVt 2 
L WO = L WO+MOVL 1 
350 CALL RCO 
RETURN 

400 WRITE (6,1690) 

ERRMAJ* .TRUE. 

RETURN 

C CONSTRUCT LETEPT, ORTChN, CONVTB, SLTAB, STATAB AND THE FIELD TABLE 
700 I F ( ERRMAJ .OR. LBDE. EQ. LBDO) ERR=. TRUE. 

900 RETURN 

1000 FORMAT ( /1X73HERR0R- THE K5=A INPUT DATA DOES NOT IMMEDIATELY FOLLO 
*W THE PROGM=STC CARD) 

1120 FORMAT ( //1X43H*** NO STC DATA FOUND ON THE INPUT TAPE.//) 

1690 FORMAT( //1X44H** PLEASE CHECK THE INPUT VALUE OF K5 (K5=A6,18H). 

* IT MUST BE 0NE/6X37H0F THE FOLLOWING- A, BDY , CHN , STA.//) 

FND 

^0 



oooo ooooooo 


* 0£ CK RELOXY 

SUBROUTINE RELOXY ( 1 1 , l 2, NPTS» IM1,IM2) 

•RELOXY RELOCATE X, Y , ANG , ANGD, CURV , S ,FQK -RELOXY- 

INPUT- 

11*12 = INDEX RANGE OF SEGMENT DATA IN XA.YA-ARRAYS 
NPTS = NO OF PTS REQD FOR SEGMENT DEFINITION IN X* Y-ARRAYS 
I M I = INDEX OF FIRST POINT OF THE SEGMENT IN X * Y-ARRAYS 

I M2 = INDEX OF LAST POINT OF THE SEGMENT IN X * Y-ARRAYS 

NIM = LENGTH OF X, Y-ARRAYS 

N = SEGMENT INDEX 

OUTPUT- 

I M2 = INDEX OF LAST POINT IN RELOCATED X » Y-ARRAYS 
RELOCATED X , Y ,. .-ARRAYS 
ADJUSTED I M A » I MB INDEX LIMIT VALUES 

Common /csegme/ i a ( io) , i b ( io) , i ma ( io) ,IMB< io) * JTYPE ( 10) , 

I N « NSEG • N I » N I M 

COMMON /CDS2 / X ( 100 ) , Y ( 100 ) , ANG ( 100 ) , ANGD ( 1 00) . CURV ( 100 ) » 

I S( 100) ,FQK( 100) ,DEV( 100 ) * CURVB (100 ) 

COMMON /TROUBL / ERR * ERRMA J* I NERR * PRE RR 
LOGICAL ERR, ERRMAjfl NERR* PRERR 

NADD = NPTS - (I2-I1+1) 

IF = IM2+I 
IT = I F ♦NADD 
NMOVE = NIM-IM2 
IF(NADD.GE.O) NMOVE=-NMOVt 
NIM = NIM+NADD 
IF ( NIM. LE. 100) GO TO 30 
ERR = .TRUE. 

WRITE (6,1030) 

RETURN 

1030 FORMAT! /1X67HSORRY - THE NO. UF OUTPUT PTS. EXCEEDS THE ALLOCATED 
•STORAGE (200).) 

30 IF ( NMOVE*NADD.EQ .0 ) GO TO 50 

CALL MOVE ( 3 , X ( I F ) , X ( I T ) , NMO VE , 1 , 

1 Y< IF) ,Y( IT) , NMOVE, l, 

2 ANG< IF ) ,ANG (IT) , NMOVE ,1 ) 

CALL MOVE! 3 , ANGD ( I F ) , ANGD ( I T ) , NMOVE , 1 , 

4 CURV (1F),CURV(1T), NMOVE * 1 , 

5 S( IF ) ,S( IT) , NMOVE, l) 

CALL MOVE ( 3 , FQK ( I F ) , FQK ( I T ) , NMOVE , i , 

7 DEVI IF) ,DEV( IT), NMOVE, 1, 

8 CURVH( IF) ,CURVB( IT) , NMOVE, 1) 

50 I M 2 = I M 1 ♦ NPTS-1 

I F ( IM2.LT.IM1 ) GO TO 70 
DO 60 1 = I M 1 , IM2 
DE V ( I ) = 0. 

CURVB ( I ) =0 . 

60 FQK ( I ) = 0. 

70 I MB ( N ) = I M2 
NP1 = N+l 

IF(NPl.GT.NSEG) GO TO 900 
DO 80 NN=NP1»NSEG 
IMA (NN > = IMA(NN)+NADD 
80 IMB(NN)=IMB(NN)+NADD 




no o o o o 


-SERS1- 


*DECK SERS1 

SUBROUTINE SERS1(XL,Y1, X2,Y2, A) 
♦SERS1- NACA SERIES-1 COWL CONTOUR 


INPUT- 

XI, Y1 = COORDINATES AT HIGHLITE 
X2,Y 2 = COORDINATES ON COWL SURFACE 
A = X/X LIMIT POINT 


OUTPUT- 

CALC VALUES OF X,Y,ANG,ANGD,CURV, S 


1 

1 


COMMON /CBEND / NBC ( 2 ) , ANGE ( 2 > , CURVE ( 2 ) ,FEND( 2 I 

COMMON /CPI / PI , TWO PI , PI02 , PIQ4»T0DEG»T0RAD 

COMMON /CSEGME/ I A ( 1 0 ) , I B ( 10 ) , I MA ( 10 ) * ! MB ( 10 ) , JT YPE ( 10 ) , 

N , NSEG , N I , N I M 

COMMON /CDS2 / X ( 100 ) , Y { 100 ) , ANG ( 100 ) , ANGD ( 1 00 ) , CURV ( 100 ) 

S( 100) ,FOK( 100) , DE V ( 100 1 , CURVB ( 1 00 ) 
DIMENSION ANGBI100) 

EQUIVALENCE (ANGB, CURVB) 


* 


DIMENSION 


XS1C40),YSI(40),TS1(40) 


DATA X S 1 / 

*0. , .000106, .0003062, . 000 6 46 1 , . 001 2998 ,. 002003 1 ,. 003966* , .006002, 
*.00 8, .01, .015, .02, .025, .03*. 035, ,04* 

*.045, .05, .06, .07, .08, .09, . 1 , . 12 , 

*.14, . 16, • 18, .20, .22, .25, • 3, .35, 

*.4, .45, .5, .6, .7 ,.8, .9, 1.0/ 

DATA YS 1 / 

*0., .0112, .019, .0275, .0388 , .04 7969, . 066707 ,. 08 1 17 , 

*.0931 18, . 10386, . 1 2 72 7 1 , . 1 4745 8, . 1 657 86 ,. 1 82977 , . 199304, .2 14829, 
*.229594, .243677, .270135, .29478, .318041 ,.340196,. 361 381, .40087, 
*.43654, .468883, . 4987 88 ,. 5 26959, . 5537 14 ,. 59 1484, . 648994, . 700757, 
*.74746, .789479, .82 7209,. 8 908 7,. 939554,. 9737 16,. 993649,1./ 

DATA T S 1 / 

*0., 52. 5 2 592, 30. 796 79, 2 1.0434 3, 14. 69820, 

*11.71671,7.996274,6. 397164, 5.61 8328,5.133687, 

*4.308968, 3. 82 1510, 3. 53 32 77, 3. 342515, 3. 1831 52, 
*3.029897,2.884790,2. 755270,2.545330,2.388930, 

*2. 268497, 2. 165982, 2.068093, 1 .875127, 1.697514, 

*1.5 52614, 1.446208, 1 . 368 1 0 8 , 1 . 30 379 7 , 1 . 21 72 1 3 , 

*1.09049 1, .9 81545, .88 5102, .79 7 345, . 715438, 

*.560407, .412448, .2 69017, . 1306 3,0./ 

C DETERMINE CUT-OFF POINT, NPTS 

I F ( .Q5.LE.A .AND. A.LE.l.) GO TO 50 
WRITE (6,1050) A 
CALL ERR0R1 
50 DO 60 K = 1 7 , 40 

IF(XSKK).GT.A) GO TO 70 
60 NPTS = K 



RELOCATE ARRAYS 
70 II = I AIN) 

12 = l B ( N ) 

I M 1 = IMA(N) 

I M2 = IMB(N) 


C 



CALL KELOXVC II, I2» NPTS, IM1.IM2) 

X R = X2-XI 

YR = Y2-YL 

AR = YR/XR 

K = 1 

DO 120 1= IM 1, IM2 

X( U = X 1 + XR*X S 1 ( K ) 

Y ( I ) = Y1+YR*YS1 (K) 

I F ( I.EQ.IMI) GO TO 115 
ANG< I )= ATANC AR*TS1(K) ) 

GO TO 118 
l L5 ANG( I ) *P l Q2 
lib ANGD( I )=ANG( 1 )*TODEG 
120 K » K*1 

NBCIll* 1 

NBC ( 2 ) = 1 

ANGEl 1 ) =ANGD( IM1 I 

ANGE( 2 ) = ANGO( IM2) 

ANGB( IM11=ANG( IM1) 

CALL BFACES(X,Y,ANGB,CURV,FOK,S. IM1.IM2) 

CALL FHEAD (51) 

WRITE 16,11501 X1,Y1,X2,Y2.A 
K * 1 

DO 160 1=1 Ml, IM2 
ANGBI I ) =ANGB( I )*TODEG 
WRITE (6,1160) 

* XS1(K),YS1(K),X(1),Y(I ) , ANGOU ),ANGB( I ) ,CURV ( I ) . S I I > 

160 K ■ K+l 

CALL MOVE ( 1 »CURV ( I Ml ) ,CURV0( I Ml ) ,K-1 , 1 ) 

RETURN 

1050 FORMAT ( / 1X70H*** INPUT ERROR » PARAMETER A DOES NOT SATISFY .05-A- 
*1.0 CRITERIA, A*F 6. 3 , ) 

1150 FORMAT! /22X, 30H* NACA SERIES-1 COWL CONTOUR *//A X16HI NPUT DATA, X 
♦1=F9.5, 3X3HY1=F9.5,/17X3HX2=F9.5» 3X3HY2=F9.5,3X2HA*F6.3,///AXl6HCO 

♦ORDINATE DATA-//71X,29H BEAM CALCULATED / 10X3HX/X7X , 3H 

*Y/Y14X, 1HZ1AX.1HR9X, 35HANGD ANGB CURV S) 

1 1 60 FORMAT (7X,F8. 6, F10.5,F16.5»F 15.5,FU.3,F12.3,F11.6,F10.5,> 

END 
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•DECK SMOINP 

SUBROUTINE SMOINP 
♦SMOINP INPUT/OUTPUT 


AND SPECIAL CONTOUR ROUTINE 


— SMOINP- 


1 


COMMON 

LOGICAL 

COMMON /ADAMOl/ 
COMMON /CALCPT/ 
COMMON /CBITS / 
COMMON /CELLPT/ 
COMMON /CLINfcS/ 
LOGICAL 

COMMON /CNTRL / 
LOGICAL 
EQUIVALENCE 
COMMON /CPI / 
COMMON /CSEGME/ 

EQUIVALENCE 
COMMON /CSMOOA/ 
COMMON /CSMOOB/ 
DIMENSION 
EQUIVALENCE 
COMMON /CDS2 / 

DIMENSION 
EQUIVALENCE 
DIMENSION 
EQUIVALENCE 
COMMON / TROUBL / 
LOGICAL 
EQUIVALENCE 


I 


PROGM ( 8 ) ,PROGSV,FILIN,FILOT,REFS<5) 

FILIN, FILOT 

NAME (6), ADDRESI6) , TITLE (6) , IDENTI6) 

DX , XMOD 
B I TS, BLANK 
DZETA 

LINES, 0MITFK.PTITLEI6) 

OMI TFK 

K5 1 1 ) , STA (2 ) » INCLUDI2) .DELETE (2) , I NSERT , CARRY 

CARRY 

( BOY , STA ) 

P I , TWOPI ,PIQ2,PIQ4,T00EG, TOR AD 

IA( 10) , IBUO) ,IMA( 10) , I MB (10) ,JTYPE(10) , 

N,NSEG, N 1 1 , N I M 

(NI.NII ) 

DEVA120), FENDA ( 2 0 ) » ANGAI 20) »CURVA( 20 ) * NARB 
XA( 100), YAHOO) »DEVI (100) 

Z A ( 1 00 ) , R A ( 1 UO ) 

( Z A » XA ) • ( RA, YA) 

X ( 100 ) * Y ( 100 ) ,ANG( 100) ,ANGD(100) .CURVllOO). 

SI 100) ,FQK( 100) »DE V ( 100 ) » CURVB 1 100 ) 

DUMI 100) 

I DUM.CURVB) 

2 I 100) ,R I 100) 

(ZtX) v (K f Y) 

ERR.ERRMAJ, INERR.PRERR 
ERR.ERRMAJ, INERR,PRERR, ERRCAS 
I ERRCAS, INERK ) 


LOGICAL 


UPPER 


DIMENSION CNAMES(A) 

DATA CNAME S/090. * 092 . * 99 3. ,991./ 


♦♦♦ DEFINE THE NUMBER OF SEGMENTS AND THE INDEX LIMITS 
NSEG = NUMBER OF SEGMENTS 

N = SEGMENT INDEX 

IAIN) , IB(N)=LIMITS OF SEGMENT IN THE XA, YA LISTS 
TYPE(N)=TYPE OF SEGMENT 
A5 N =1 

I = 1 

I JUNC T = 1 
GO TO 5b 

50 IF I XAI I ) .EQ.XAI 1-1 ) .AND. YA I I ) .E Q . YA I I - 1 ) ) GO TO 70 

55 IF! I-NI ) 60,155,155 
60 DO 65 J = 1 » A 

65 IFIXAI I ) .EQ.CNAMESI J ) ) GO TO 75 
IFI I.EC.IJUNCT) GO TO 70 
I =1 + 1 

GO TO 50 



C CONTOUR JUNCTURE 
70 J =1 

75 J TY PE I N ) = J 
IAIN) = I 



N = N + l 

GO TO < 110, 120, 130,1*0), J 


C ARBITRARY CURVE 

110 I B ( N- 1 ) =0 
1 = 1*1 
GO TO 50 

C ELLIPSE 

120 IB(N-I)=l+3 

IF ( ( I42.E0.NIJ .OR. <XA( 1*2) •E-O.XAIIO) .AND. YA (1 42 ) . EQ. YA( I +3 J ) ) 
♦ I B ( N- I ) = I +2 
GO TO 150 

C SPIRAL 

130 I B ( N- 1 ) = I 43 
GO TO 150 

C SERIES i 

1M) I B I N- 1 ) = I +2 
150 I = IB(N-I)4l 

I JUNCT = I 
GO TO 55 

C END OF INPUT DATA, FILL ZERO IB(N) 

155 NSEG * N-l 
IB(N-1 )*NI 
DO 160 N* 1 , NSEG 

160 IF(IBIN).EO.O) 1BIN)=1AIN41)-1 
RETURN 

C*** FIT THE SPECIAL CONTOURS 
ENTRY CONTRS 
DO 195 N- 1 , NSEG 
IMA(N>= 1 A ( N ) 

195 I MB I N J = I B ( N ) 

NIM * IB(NSEG) 

N = 1 

200 J = JTYPE(N) 

IF(J.LE.l) GO TO 790 
OMITFK= .TRUE. 

CALL FHEAD ( 6 ) 

WRITE (6,1202) N , BDY 
I * I A ( N ) 

12 * I B( N ) 

IM « IMA(N) 

IM2 « IMB(N) 

XI * XA( 1 4 1 1 

Y 1 * YA( 1 4 1 ) 

IF(N.LE.l) GO TO 206 
XI = X( IM-i) 

Y 1 * Y(IM-l) 

206 X2 = XA( 142) 

Y2 * YA( 142) 

IF(N.EQ.NSEG .OR. JTYPE t N+H .NE . I ) GO TO 220 
X 2 = XIIM241) 

Y2 = Y( IM2+1 ) 

220 I F ( IM.LE.l ) GO TO 222 




ANG 1 = ANGD( IM-1 ) 

222 IF( ( I2-D.E0.3 .AND. ( XA < I + 3 ) .NE . B I T S. AND. X A< 1 43 ) .NE .999 . ) ) 

* ANGl=XA(I+3) 

I F ( IM2.GE.NIM) GO TO 224 
ANG2 = ANGO ( IM2 + 1 ) 

224 I F ( ( I2-I J.E0.3 .AND. ( YA { I + 3 ) .NE . B I T S .AND. YA ( I 43 ) . NE. 999. ) > 

* ANG2 = YA ( I 43 ) 

I F C J- 3 ) 250,300,400 

C FIT THE ELLIPSE 

250 CALL ELLIPl X1,Y1,ANG1, X2,Y2,ANG2, YAI I ) ) 

IFIERR) GO TO 790 
DZETA = 5 . *TORAD 
CALL ELL1PT 
GO TO 790 

C FIT THE HYPERBOLIC SPIRAL 

300 I F < Y A C I J.EU.2.) GO TO 320 

CALL HYPER1(XI,Y1,ANG1, X2,Y2,ANG2) 

GO TO 350 

320 CUR V 1 = YA( 143) 

CALL HYPER2(X1,Y1,ANG1,CURV1, X2,Y2) 

350 IF(ERK) GO TO 790 
CALL HYPTS 
GO TO 790 

C SERIES 1 COWL LIP. 

400 CALL SERSllXl.Yl, X2.Y2, YA (I) ) 

C INDEX TO THE NEXT SEGMENT 

790 I F ( ERR ) ERRCAS* . TRUE . 

ERR = .FALSE. 

N = N4l 

IF(N.LE.NSEG) GO TO 200 

C IF ERR HAS BEEN ENCOUNTERED, DO NOT WRITE OUTPUT FILE 
I F ( .NOT .ERRCAS) GO TO 800 
ERRMAJ= .TRUE. 

ERRCA S= .FALSE. 

RETURN 

C MAKE THE CUR VAL I N EAR DISTANCE CONTINUOUS 
800 DS = 0. 

DO 005 1=2, NIM 
I F ( S ( I ) .EO.O. ) D3 = S ( I - 1 ) 

805 S ( I ) = SCI ) +DS 

C*** WRITE TOTAL COMPUTED DATA FOR THE BOUNDARY 
OM I T FK = .TRUE. 

CALL FHEAD(NIM44) 

WRITE (6,1800) (I,S(I),X(l),Y(I ) , ANGD( I ) ,CURVB(I ),FQK(I),I*1,NIM) 
1800 FORMAT( / 2 1 X24HC0NS0L IDATED OUTPUT DATA//4X59HI S X,Z 

* Y , R AN GO CUR V F QK/40 X7HDEGR E ES/ ( 2X , I 3 , OPF 10. 5 

*,2FH.5,F9.3,F10.6,F10.5» )») 



RETURN 



10<*0 FORMAT ( /1X59H*** ERROR - NUMBER OF INPUT POINTS <XA*YA) IS LESS T 
♦HAN 2.) 

1042 FORMATI /1X34HINPUT TAPE RETRIEVAL INFORMATION -//2X7HF0UN0 = 13, ) 

1202 FORMAT ( /flH SEGMENT , I 3, 9H OF BDY=, A6/26H 

♦ I 
ENO 





♦DECK SMOTH 

SUBROUTINE SMOTH 

•SMOOTH MAIN PROGRAM FOR SMOOTH 


C READ INPUT, DETERMINE NUMBER AND TYPE OF SEGMENTS 
CALL SMOINP 

C SMOOTH ARBITRARY SEGMENTS 

CALL SMOXEQ 

C CALC SPECIAL-CONTOUR SEGMENTS, WRITE OUTPUT 

CALL CONTRS 


-SMOOTH- 



o o 


♦DECK SMOEXQ 

SUBROUTINE SMOXEQ 

♦SMOXEQ ARBITRARY SEQMENT SMOOTHING -SMOXEQ- 

COMMON /CBITS / BITS, BLANK 

COMMON /CBEND / NBC ( 2 > , ANGE < 2 » , CUR VE < 2 ) , FEND I 2 I 

COMMON /CNTRL / K 5 ( I ) , S T A ( 2 ) , INCl UO < 2 ) , OE IE TE ( 2 ) , I NSE RT , C ARR Y 

EQUIVALENCE ( BOY , STA ) 

COMMON /CSEGME/ I A { 10 1 , 1 B ( 10 ) ♦ I MA ( 10 ) , I MB < 10 ) » JT YPE UO ) , 

I N.NSEGf NlItNiM 

EQUIVALENCE (NItNII) 

COMMON /CSMOQA/ DEVA(20), FE NDA ( 20 > , ANGA < 20 ) ,CUR VA< 20 ) , NARB 
COMMON /CSMOOB/ XA ( 1 00 ) * YA ( 1 00 > ,DE VI ( 100 ) 

COMMON /CDS2 / X ( 100 > * Y C 100 ) »ANG ( 100) * ANGOI LOO) *CURV( 100 ) » 

I S( 100>,FQK< 100) ,DEV( 100) ,CURVB(100> 

COMMON /CLINES/ L INE S ,0M I TFK , PT I TLE { 6 ) 

LOGICAL OM I TFK 

COMMON /TROUBL / ERR , ERRMA J , I NERR » PRE RR 
LOGICAL ERR,ERRMAJ,INERR,PRERR 

LOGICAL ERRCAS 

EQUIVALENCE ( ERRCAS, 1 NERR > 

LOGICAL DONE 


C*** SMOOTH ARBITRARY CURVES 
NSWEEP= I 

170 DONE * .TRUE. 

ANGREF* 0. 

N =1 

NARB = I 

175 IF( JTYPE(N)-l) 189,176,190 

176 I * IAIN) 

12 * l B ( N ) 

C END CONDITIONS 

DEVI ( 11-0. 

OF V I ( I 2 ) *0 . 
f LND( n-o. 

FEND( 2 ) a 0 • 

NBC ( 1 ) * 0 
NBC ( 2 ) * 0 
L * 0 

180 LL * NARB+20*L 
IF(FENDAILL).EQ.BITS) GO TO 181 
NBC ( 1 )* L 

FEND( 1 ) =FENDA ( LL ) 

181 IF< FENO A(LL+1).EQ. BITS) GO TO 182 
NBC (2)* L 

FEND( 2) S FENDA(LL + 1 ) 

182 L * L ♦ 1 

I F ( L . L £ . 2 ) GO TO 180 

CHECK FOR UNDEFINED END CONDITIONS 
ENO-1 

IF(FEND( 1) .NE.999.) GO TO 18A 
IF(N.EQ.l) GO TO 187 
IF(JTYPE(N-1 ) • GE . 0 ) GO TO 187 
IF ( NBC( 1 ) • EQ • 1 ) FEND( 1 ) =ANGD ( I -1 ) 
IF (NBC( 1 ) .EQ.2 ) FEND(l) *CURV(I-i ) 

C END-2 

1 84 IF(FEND( 2) .NE.999. 1 GO TO 186 
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IF (N.GF.NSEG) GO 10 200 
IF(JTYPE(N+l).Gfc .0) GO TO 187 
IF(NBC(2).EQ.l ) F ENO ( 2 I =ANGO (12+1) 

IF ( ' i 8 C C 2 ) .E0.2 ) FEN0(2)=CURV( 12+1 ) 

186 I F { CEVA(NARB).NE.BITS) OE V 1 ( I) =DE VA ( NARB ) 

IF ( DE VA(NARB+1 ) .NE .B ITS) OEVII I 2 ) *DE VA ( NARB+1 ) 

OMITFK= .TRUE. 

CALL FHF A0( 17* 12-1) 

WRITE (6,1186) N » l) D Y 
S( I ) =0. 

ANGl 1 ) = ANGRE F 
CALL SMOG 
JTYPE IN )=-i 
12 = I B I N ) 

ANGREF = ANG( 12 ) 

GO TO 188 

187 DONE = .FALSE. 

188 I F ( ERR ) E RRC A S- . I R UE • 

ERR = .FALSE. 

1H9 NARB = NARB+2 
190 N = N*1 

I F C N.LE.NSEG) GO 10 175 

RETURN TO 170 TO LOOP THROUGH SEGMENTS AGAIN 
TO PICK UP THOSE WHICH HAO undefined END CONDITIONS 
I F I DONE ) RETURN 
NSWEE P = NSWEEP+l 
IF( NSWEEP.LE. 10) GO TO 170 
200 WRITE (6,1200) 

ERRCAS=.TRUE. 

RETURN 

1106 FORMAT ( /8H SEGMENT , I 3 , 9H OF bD Y = , A6/26H 

* ) 

1200 FORMAT ( 1X50H*** ANGA , CUR VA = 999 END OPTION USED INCORRECTLY) 

END 
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♦ DECK SMOO 

SUBROUTINE SMOO 

SMOO— ANGLE, CURVATURE AND ARC LENGTH -SMOO- 

OF A SMOOTH CURVE PASSING CLpSE TQ GIVEN POINTS 
THE SMOOTHING OPTION HAS NOT BEEN INCLUDED. INSTEAD, A 
CURVE IS FITTED TO THE GIVEN X,Y POINTS. 

INPUT- 

NA MEANS NOT AVAILABLE IN THIS VERSION 

I A , IB * RANGE OF INDEX IN LISTS XA , YA , DEVI , DEV, X , Y, ANG, CURV , E , S 
XA = LIST OF INPUT X 

YA * LIST OF INPUT Y 

NA OEV I * LIST OF POINT MOVEMENT PARAMETERS 
NA TORQ1 = TORSIONAL SPRING COMPLIANCE - FIRST END 

NA TflRQN * TORSIONAL SPRING COMPLIANCE - SECOND END 

NBC ( L ) * BOUNDARY CONDITION INDICATOR FOR FIRST(L*1) AND SECOND(L»2 
* 0, 1, OR 2 

ANGE!L)= ANGLE IN DEGREES, IF NBC(L)«l 
CURVE ( L )=CURVATURE , IF NBC(L)=2 

FEND( L )=RAT 10 OF SHEAR FORCE, END/NEXT TO END INTERVAL, IF NBCIL 


NOTES- 

THE UNITS OF XA,YA,DEVI , TORQI AND TORQN MUST BE THE SAME, 

FOR EXAMPE, INCHES. DEVI IS PROPORTIONAL TO THE CUBE ROOT OF 
THE SPRING COMPLIANCES. TORUS ARE DIRECTLYPROPORTI0NALTOTHE 
END TORSIONAL SPRING COMPLIANCES. LARGER VALUES OF DEVI YEILD 
LOWER APPLIED FORCES (AND GRfcATER- DEVIATIONS), LARGER VALUES OF 
TORQ YIELD LOWER APPLIED END MOMENTS. 


C 

C NA 
C 

C NA 
C NA 
C NA 
C NA 
C NA 
C NA 
C NA 
C NA 
C NA 
C NA 


OUTPUT BASED ON ADJUSTED POINTS- 

DEV-V a DEVIATION FROM THE INPUT POINTS IN THE NORMAL DIRECTION, IN 

X , Y * ADJUSTED COORDINATES 

ANG * ANGLE IN RADIANS 

ANGO * ANGLE IN DEGREES 

CURV » CURVATURE, 1/iN 

FOE I ■ APPLIED FORCES, DELTA V , 1/IN2 

S » LENGTH ALONG THE CURVE, IN 

ED « ENERGY OF EQUIVALENT SPRINGS UNDER DEFLECTION DEV, 1/IN 
ET = SPRING ENERGIES, 1/IN 

RMSDEV* ROOT MEAN SQUARE DEVIATION OF POINTS WITH DEVI.NE.O 

RMSF = ROOT MEAN SQUARE VALUE OF F/EI, 1/IN2 

RMSF1 = ROOT MEAN SQUARE VALUE OF F/EI FOR UNADJUSTED BEAM 


COMMON /CCURV / 
COMMON /CB / 
DIMENSION 
EQUIVALENCE 
DIMENSION 
EQUIVALENCE 
COMMON /CBEND / 
EQUIVALENCE 
COMMON /CCUBE / 
COMMON /CSEGME/ 

1 

COMMON /CSMOOB/ 
COMMON /CDS2 / 

1 


NN , I D I M, G ( 2 ) 

A ( 2 ) 

U ( 2 ) 

(U,G> 

V( 100) ,W( 100) 

<W,V) 

NBC ( 2 ) »ANGE I 2 ) » CURVE ( 2 ) ,F END( 2 ) 

(NBC 1, NBC ),(NBC2, NBC ( 2 I ) 

NBCS ( 2 ) , SAVS ( A) .FENDS (2 ) 

I I A< 10), I IB ( 10) , IMA (10) , I MB (10), JTYPEC10), 

N , NSEG ,N I ,NI M 

XA(IOO), YA(IOO) ,DEVI (100) 

X( 100) ,Y ( 100) ,ANG( 100) ,ANGD(100) , CURV (100 ) , 
S( 100) ,FQK( 100) ,DEV< 100) .CURVB(IOO) 

E ( 100) 



DIMENSION 



EQUIVALENCE 
COMMON /CSMOOD/ 
COMMON /ERASE / 
DIMENSION 
EQUIVALENCE 
COMMON /CSMOOE/ 
COMMON /TROUBL / 
LOGICAL 


( E.FUK) 

SGAMMA.SZETAl.SZETAN 
H( 8, 100) 

CHD( 8,99), G1 ( 100) »GN( 100) » I NTER1 ( 100 ) 

( CHD » H ( 8 * 1 ) ) > ( INTERl.GltH(lfl)) * ( GN,H( l , 1A ) ) 
GAMMA ( 100 ) 

ERR,ERRMAJ,I NERR.PRERR 
ERRtERRMAJ»INERR.PRERR 


DIMENSION ENDP AR ( 3 ) 

DATA ENDPAR/5HFEN0A,4HANGA, 5HCURVA/ 


C WRITE OUT END CONDITIONS 
ANGE ( 1 ) =F END ( 1 ) 

ANGE ( 2 ) =FENO( 2) 

CURVE ( 1 ) = F END ( 1 ) 

CURVE ( 2 ) = FEN()< 2) 

WRITE (6,1020) ENDPAR (NBC 1 + 1 ) ,FEND( 1 ) , ENDPAR ( NBC2+1 ) * FEND( 2 ) 
1020 FORMAT ( 10X, A7H* A CURVE HAS BEEN FITTED TO GIVEN X,Y POINTS *// 
1 6 X , 1 8 HE N D CONDITIONS - , A 5 ,4H (1) = ,F9. 5 , 10X ,A5 , AH ( 2 ) * , F9 . 5 ) 

*H( 2 ) = F9.5» ) 


1A = 11A(N) 

IB = IIB(N) 

NPTS = IB-IA+1 

IAB = NPTS 

C CALC FORCES, F/EI, APPLIED TO THE BEAM WHICH PASSES THROUGH POINTS 
CALL BFACESI XA, YA, ANG,CURVB,E,StIA,IB) 

CALL M0VE(2,XA( I A ) , X ( I A ) , I AB , 1 , YA ( I A ) , Y ( I A ) , I AB , l ) 

I = IA 

K = 1 

AOS ANGU( I )=ANG( I )*57.29S78 
Alb K = K4 1 

I =141 

IF(NPTS-K) A30, AOS, AOS 
C SMOOTHING LOGIC HAS BEEN REMOVED 
A 30 WRITE (6,1100) 

WRITE (6,1110) ( XA ( I) ,YA (I) ,DEVI ( I ) ,DEV( I ) ,X( I ) , Y( I ) , ANGDII) , 

1 CURVB(I) ,FQKm,SII) ,I = IA,IB) 

1100 FORMAT ( 72X, 10X, 1SHAPPLIED A RC /6X 1 7H I NPUT COORD IN ATES 17 X , 20HAD J 

* US TED COORDINATES22X, 17HF0RCES LE NGTH/7X89HX A » Z A YA,RA 

* 0 E V I DEV X,Z Y , R ANGD CURV FQK 

* S/33X'37H*1000 DEGREES) 

1110 FORMA T( 2X,2F 11.5, F 7. 2,3PF 7.2, 0P2F 11.5, F9.3.F 10.6 ,2F 10.5, ) 

RETURN 


ENO 

OVERL AY ( S TC » 1,2) 



♦DECK 8UIL0T 

PROGRAM BUILDT 
COMMON /CMAXIT/ 

LOGICAL 

COMMON /CPRINT/ 

COMMON /TROUBL / 

LOGICAL 

COMMON /SELECT/ 

GO TO (5,10,15) 

5 CALL BLDTAB 
GO TO 20 
10 CALL BPSORT 
MAJCTR* 0 

C INSERT SPECIAL BOUNOARY TYPES IN THE STATION TABLE 
15 CALL ISBOT 

IF(ERR) CALL ERROR 1 
I F ( PDUM (lO).NE.O.) CALL EDUMP 
20 RETURN 
END 


MAXIT,MAJCTR,GREFIN,EDUM 
GREF IN 

PRTES2,PRTB,PRTA,PREFIN, PREFN2, SSONI C* PDUM( 20 ) 
ERR»ERRMAJ,INERR,PRERR 
ERR,ERRMAJ,INERR,PRERR 
LENTRY 

, LENTRY 
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♦OECK BLDTAB 

SUBROUTINE BLDTAB 

♦ BLDTAB COALLATE BDY-TABLE » BUILD LE-TE PT TABLE -BLDTAB- 


INPUT- 
BOUNDARY TABLE, / BUY I AB/ 
CHANNEL INPUT DA I E , /CHDATA/ 


OUTPUT - 

CONDENSED BOUNDARY TABLL , /BDYTAB/ 
ORDEREO EDGE POINTS, /LETEPT/ 


COMMON /ALLCOM/ M ACHA , PS A , T S A , P T A , T T A , AX I A , RGA, GAMA , 

1 MACHC,PSC,TSC,PTC,TTC, AXI C »RGC» GAMC , 

2 OAXI T,SCALEA,TTE,CHOTST 

REAL M ACHA ( 1 ) , MAC HC 

LOGICAL AXIA ,AXIC .CHUTST 

BOUNDARY TABLE 


INDEX- LB=LBDO,LRDE 

LRNEX T= INCREMENT TO NEXT BOUNDARY 

LBZl = INCREMENT TO THE FIRST BOUNDARY POINT <*0 BEFORE COALLATIO 
CHNAME= CHANNEL WITH WHICH THE BOUNDARY OATA IS ASSOCIATED 
UP = T OR E FOR UPPER OR LOWER BOUNDARY 

LEDEX = RELATIVE INDEX OF L.E. POINT WHEN LOWER AND UPPER SURFACE 
CONTOURS ARE CONNECTED 

BDNAME ,LBA,LBB=NAME AND INDEX LIMITS OF SPECIFIC BOUNDARY 

DATA WHEN BOUNDARIES ARE COALLATED 
COMMON /CHDATA/ BUT (I) , LBNEX T{ 1) , LBZ 1 (1) , 

1 CHNAME (I )*UP( II , LED£X( 1 ) , 

2 ZBT( L),RBT(1),ANGBT(42) 

LOGICAL UP 

INTEGER BDT , CHNAME , BONA ML 

DIMENSION BDNAME (1 ) ,LB A ( L ) , LBB ( 1 ) 

EQUIVALENCE ( BDNAME, ZBT) , ( LBA ,RBT ) , ( LBB , ANGBT ) 

COMMON /IXORIG/ LHO,LHE, LBDU,LBDE, LTO,LTE, LWO,LwE, lfo,lfe, 

♦ LO,LESTA, LDUMI8J, 

♦ MO , NM , NJ.NFCOLS, MA XN J , MAXOL , MAXNM , MAXLE , 

♦ LEO, LEE, LRO,LRE,LRD 

DIMENSION LIMITS124) 

EQUIVALENCE (LIMITS, LHO) 

TABLE OF LEADING EDGE AND TRAILING EDGE POINTS 
INDEX- LE=LEO,LEL , 10 

NL E , N TE =NU . OF L.E. AND T.E. COINCIDENT PTS, RESPECTIVELY 
CHL,CHU=NAME OF CHANNEL ABOVE AND BELOW PT, RESPECTIVELY 
BDL ,BOU=BOUNOARY NAMES ASSOCIATED WITH THE POINTS 

NUSED = COUNT OF TIMES THAT PUINT USED IN CONSTRUCTION OF /ORTCHN/ 
COMMON /LETEPT/ XL ( I ) , YE < 1) , ANGE ( 1) , NLE ( 1 1 ,NTE U I • 

I CHL( l),CHU(l),BDL(l) ,BDU(1 ) , NUSED (491 ) 

INTEGER CHL,CHU,BDL,BDU / 


COMMON /C8ITS / 
COMMON /CPI / 
COMMON /ERASE / 
DIMENSION 
EQUIVALENCE 
INTEGER 

COMMON / T ROUBL / 
LOGICAL 


BITS, IBLANK 

PI , T WOP I ,PIQ2,PIQ4,T0DEG,T0RAD 

XX (1 ) ,YY,ANGG,NL,NT,CNL,CNU,BNL,BNU,NZERO 

I XX( 10) 

( IXX.XX) 

CNL,CNU,BNL,BNU 
ERR,ERRMAJ, INERR,PRERR 
ERR, ERRMA J , I NERR , PRE RR 




INTEGER HD1,H02,HNAME2,CHN,HL0WER,HUPPER,UPPER 

LOGICAL WALL 

DATA HLOWER »HUPPER/5HLOWER» 5HUPPER/ 

C RELOCATE BDY-T ABLE OOWN AND ADJACENT TO CHDATA-TABLE 
NMOVE a LBDE-LBDO+1 

CALL MOVE ! 1 , BDT ( LBDO I ,BDT I LHE+ 1 ) , NMOVE , U 
LBDO = LHE+1 
LBDE » LHE+NMOVE 

C DEFINE DOUBLE POINT TOLERANCE, DPTOL 
DPTOL « l.E-5 

C** BOUNDARY TABLE SORT 

C RELOCATE TOGETHER THE BOUNDARIES WHICH BELONG TO THE SAME WALL 

LB1 = LBDO 

305 LB2 = LB1+LBNEXT !LB1) 

IF <LB2.GE.LBDE ) GO TO 350 
C COMPARE CHANNEL NAME AND UPPER! LOWER I WALL 

310 I F ( CHNAME (LB2).NE.CHNAME(LBi) .OR. ( UP ( LB2 I . AND. .NOT .UP! LB1 ) ) 

* .OR. ( UP ( LB1 ) .AND. .NOT .UP i LB2 ) ) ) GO TO 340 

C DOES LB2 FOLLOW LB 1 , COMPARE THE Z,R VALUES OF THE END POINTS 

LI = LBl+LBNEXT!LBl)-9 
IF(ABS(ZBT!LB2)-ZBT(L1)) .LT .DPTOL .AND. 

1 ABS(RBT!LB2)-RBTIL1J ) .LT. DPTOL) GO TO 315 
C DOES LB2 PRECEED LB1 

L2 « LB2+LBNEXT (LB2I-9 

IF!ABS!ZBT!L2)-ZBT!LBin.GE. DPTOL .OR. 

1 ABS ! RBT ( L2 J-RBT ( LB1 ) I .GE . DPTOL ) GO TO 340 
LI * LB1 

GO TO 316 

315 LI = LBl+LBNEXTtlBl) 

316 NB2 * LBNEXTILB2I 

» T a t IfNBg 

u - 

L 22 = L 2 + NB2 

IFILB2.E0.LI I GO TU 340 

CALL MOVE ( 3 , BDT ( L I ) , BDT < LT ) , LI - i-LBDE , l , 

1 BDT!L2) ,BDT(LI ) ,NB2,l, 

2 BDT(L22),BDT!L2) ,LBDE-L2U,1) 

IF ( L I . EQ.LB1 ) GO TO 305 

340 LB2 « LB2+LBNEXT I L B 2 ) 

I F ( LB2.LT .LBDE ) GO TO 310 
LB1 = LBl+LBNEXT ILB1 1 

GO TO 305 

C** COALLATE THE BOUNDARIES ALONG ONE WALL INTO ONE CONTOUR 
350 LB1 a LBDO 

355 NCOAL = 0 

CHN a CHNAME! LB 1) 

WALL * UP(LBl) 

360 LB2 * LB1«-LBNEXT<LB1) 

IF! LB2.GE.LBDE .OR. BOT ( LB2 » . tO . I BLANK ) GO To 400 
C IS THIS BOUNDARY CONTINUED 

IF(ChNAME(LB2) .NE .CHN .UR . < UP! LB2 ) . AND. .NOT. WALL) .OR. 

* (WALL .AND. .NOT .UP (LB2 ) ) ) GO TO 380 

qk 
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LI = LB1 + LBNEXT(LB1 1-9 
L 2 = LB2+LBZ l ( LB2 ) 

IF< AHS(ZBT(L2)-ZbT<Ll) ).LT.DPTOL .AND. 

1 ABS(RBT(L2)-RBT(Lin.LT.DPTOL) GO TO 365 
C ERROR- BOUNDARY TABLE NOT CONTINUOUS 

IUP=HlOwER 

I F ( UP(LBI) ) I UP = UP PER 

WRITE (6, 1365) IUP,CHNAME ( LB 1 ) ,1 BT I LI ) , RBT I L l ) • ZBT C 12 ) , 
l RBT ( L 2 ) 

CALL ERRUR1 

MOVE THE LB1 Z »R » ANG-DA TA UP 6 SPACES IF THERE EXISTS 
AN ANGLE DISCONTINUITY, 9 SPACES IF THERE DOES NOT. 

(6 SPACES IS NOW ALWAYS USED SO THAT A PRIMARY ORTHOGONAL WILL BE 
GENERATED AT BOUNDARY JUNCTIONS, A/71) 

365 LUP = 6 
C I F ( ANGBT (L2).EQ.ANGB1(Ll ) ) LUP*9 

LF = L H 1 +6 *L BZ 1 ( L B 1 ) 

IT * LF+LUP 

NMOVE = -( ILB1+LBNEXT(LB1 )) - LF ) 

BN AME 2 = BDT ( L B 2 ) 

LNEXT2= LBNEXTILB2) 

L S T AR T = LBZKLB2) 

CALL MOVEU, BDT(LF) ,BDT(LT) , NMOVE, 1) 

IF(NCOAL.NE.O) GO TO 370 
NCOAL = 1 

8DNAME( LB1 ) = BDT (LB1) 

LBAILBl ) -L BZ 1 ( L B 1 ) 

LBBILBl )=LBA(LBl)-NM0VE-3 

3 70 LI = LH10*NCUAL 
BDNAML ( L 1 ) =BNAME2 
L B A ( L i ) =L BNEX T ( LU1 ) 

LBB(L1)=LRA(L1) ♦ (LNt X T 2- ( 6+LS TART > ) - 3 
N = NCOAL 

NCOAL = NCOAL ♦ 1 

375 IF(N.LE.O) GO TO 377 
L 1 = L B 1 + 3* ( N- 1 ) 

LBAIL1)=LBAIL1)+LUP 
IBBILl ) =LBB( L l ) +LUP 
N = N-l 

GO TO 375 

377 LBNEXT ILB1 )=LBNEXT (LBi I+LNEXT2 
LBZ1(LB1)=LB71(LB1 H-LUP 
GO TO 360 

C ELIMINATE GAPS 

380 IF( NCOAL. EO.O) GO TO 390 

LDOWN = LBZl(LBl) - 3*NC0AL 
IF ( LDOWN.LE .0 ) GO TO 390 
LF = L81+6+LBZ1 (LBI ) 

LT = LF-LDOWN 

NMOVE = LBOE-L F* l 

CALL MOVE ( 1 , BDT(LF) ,BDT(LT) , NMOVE, 1) 
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I BNLXT (LB1 ) *L BNF X I ( L H 1 J-LOQWN 
LB/ HLR1)=LH7 mm )-LI)OWN 

N * 1 ' 

385 Ll =• L B l ♦ 3* ( N- i ) 

LBA(L 1)=LBA(L1)-L00WN 
L HB ( L 1 ) =L 8B ( L l >-LOOWN 
N = N + l 

IF ( N.LE.NCOAL ) GO TO 385 
LBDE = L BDE-L DOWN 

C INDEX TO THE NEXT LSI 
390 LB1 =' LB1+LBNEXT (LB1 ) 

IFILB1.LT. LBDE) GO TO 355 

* INITIALIZE FAR FIELD INTERFACE BOUNDARY DATA IF REQ-D 
400 CALL FFINIT 


C** BUILD LEADING EDGE / TR A I L I NG EDGE POINT TABLEt 
LEE = LEO-1 4- 

LB = LBDO 

405 Ll = LB + LBZKLB) 

LL = Ll 

L 2 = LB+LBNEXT (LBI-9 

GO TO 410 

C SEARCH FOR SHARP CORNERS 

407 LL = LL + 3 

IF( ABSIZBTILL I-ZBT (LL-3) I.LT.DPTOL .AND. 

1 ABSIRBTILL )-RBT(LL-3» I.LT.DPTOU GO TO 408 
IFILL.LT.L2) GO TO 407 
GO TO 410 

C SHARP CORNER 

408 ZBTILL )=ZBT(LL-3) 

RBTILL )=RBT(LL-3) 

NZERO = -1 

NL =0 


C 


C 


NT * 0 

AN(JG - . 5* ( ANGBT ( LL ) ♦ ANGBT ( LL- 3 ) I 
GO TO 412 
410 NZERO * 0 

ANGG = ANGBT (LL) 

412 CALL SETMt 1 # I BLANK , CNL,4) 

XX = ZBTILL) 

YY * RBTILL) 

IF(UP( LB) ) GO TO 415 
LOWER BOUNDARY 
CNL = CHNAME(LB) 

BNL * BDT(LB) 

IF(LL.EQ.Ll) GO TO 420 
I F ( LL .E0.L2 ) GO TO 425 
GO TO 435 
UPPER BOUNDARY 
415 CNU = CHNAME(LB) 

BNU = BDT(LB) 

ANGG * ANGG-PI 

IF(LL.EO.Ll) GO TO 425 
IF< LL . E0.L2 ) GO TO 420 


GO TO 435 
LEADING EDGE 



/LETEPT/ 



fl o o o o o o 


4 20 NL =1 

NT =0 

GO TO 435 

C TRAILING EDGE 

425 NT = I 

NL =0 

C 435 CALL LSORTP 

*ESURTP PRELIMINARY fcDGL POINT SORT 

C SUBROUTINE ESORT 

INPUT- 

X X ( 10 ) = DATA VECTOR TO BE INSERTED INTO ARRAY-XE 
XE = ARRAY OF VECTORS SORT fcD ACCORDING TO FIRST 

L EO , L t E = INDEX LIMITS OF THE XE-ARRAY 

OUTPUT- 

XE = REVISED ARRAY OF EDGE POINTS 

LEE = REVISED UPPER LIMIT OF XE-ARRAY 

C SEARCH FOR ORDERED POSITION - J 
435 CONTINUE 
J =0 

55 1 = I 

60 LE = 10*J ♦ I-I ♦ LEO 

IF ( LE .GE .LEE ) GO TO 80 
XD = XX ( I )-XE< LE) 

IF(ABS(XD).LE.( 1.1 + TTE!) XD-D. 

IF(XD) 80,70,65 
65 J = J+i 

GO TO 55 
70 I = 1*1 

IF ( I .LE .2 ) GO TO 60 

C THE NEW POINT IS COINCIDENT WITH POINT-J 
LE = 10*J + LEO 

ANGE ( L E ) = .5*< ANGEILE ) ♦ANGG) 

NLE(LE)=NLE(LE)+NL 
NTE(LE)=NTE(LE)+NT 
I = 6 

72 LE = 10*J + I-J. + LEO 

IF( IX X( I ) ,NE. I BLANK) XEILE )=XX(I) 

I = I + I 

I F ( I.LE.IO) GO TO 72 

C RETURN 

GO TO 436 

C RELOCATE AND INSERT THE NEW LINE IN LINE-J 
80 LEF = 10*J * LEO 

LET = LEF+IO 

CALL MOVE ( 2 , XE ( L E F ) , XE ( L ET ) , LE F-LEE - l , 1 , 

1 XX,XE(LEF), 10, I) 

LEE = LEE+10 

C RETURN 

C END 

A 36 IFILL-L2) 407,440,407 


-ESORT-****** 


TWO ELEMENTS 



************* 
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C INCREMENT BOUNDARY TABLE INDEX 

440 LH = LB + LBNEXT < LB ) 

IM LB.LT.LBDE ) GO TQ 405 

C CHECK FOR A MINIMUM OF 4 POINTS IN THE LETEPT-TABLE 
IF I (LEE-LEO + I ) .LT.40) CALL ERR0R1 

C* FINAL SORT OF /LETEPT/ BY AVERAGE FLOW ANGLE 
TANG = 92 . /90.*P I Q2 
LEI = LEO 

454 NCOUNT= (LEE + l-LEI 1/10 

455 L E 2 = LEI 

460 LE2 = LE2+10 

IFILE2.GE.LEE ) GO TO 470 

C IS PT 2 IN FRONT OF PT1 (VECTOR PTI TO PT2 GT 90 DEG FROM SL ) 

ANGSL = ,5*(ANGE( LEI )*ANGE(LE2) ) 

ANG12 = ATAN3(YE(LE2)-YE (LEI) ,XE(LE2)-XE(LE1) , ANGSL) 

IF( ABS( ANG12-ANGSL ) .LE .TANG) GO TO 460 

C MOVE PT LE 2 IN FRONT OF LEI 

LI = LEI 

LT = L I ♦ 10 

L2 = LE 2 + 10 

L22 * L2+10 

CALL MOVE ( 3 « XE ( L I ) , XE ( L T) , L l-l-LEE , 1 , 

1 XE(L2),XE(LI ) • 1 0 « 1 • 

2 XE(L22) ,XE(L2» ,LE£-L2+1,1) 

NCOUNT* NCOUNT-1 

IF(NCOUNT.GE.O) GO TO 455 
WRITE (6,1468) 

CALL ERROR 1 

C INDEX LEI 

4 70 LEI = L E 1*10 

IF (LEI. LT. LEE ) GO TO 454 

* COMBINE UPPER AND LOWER CONTOURS CONNECTED BY L.E. IN THE BOY-TABLE 
LB 1 AND LB2 ARE INOICIES OF THE TWO CONTOURS 

(LOWER AND UPPER SURFACE) 

LUP * ADDITIONAL SPACE REUD FUR SUBTABLE OF INCLUDED BOUNDARIES 
LE = LEO 

472 IF(NLE(LE ) .NE.2 ) GO TU 496 
RD1 * BDU(LE) 

BD2 * BDL(LE) 

LB1 = LBF(BDi) 

LB2 * LBF ( BD2 ) 

C CHECK L.E. ANGLE DISCREPANCY 

LB = LB2+LBZ 1 ( LB2 ) 

ANG02 = ANGBT ( LB )*TODEG 
NBD2 = BDT ( LB2 ) 

LB * LBl+LBNEXT(LBl)-9 
ANGD1 = ANGBT ( LB ) *TOOEG 
NBD1 = BDT(LBl) 

I F ( ABS ( ANGD2-ANGD 1 ) . LT. . 1 ) GO TO 474 
ANGDAV® .5*( ANGD1 +ANGD2 ) 



WRITE (6,1473) ZBT (LB ) # RBT ( LB ) » NB01 »NBD2 , AN601 , ANGD2, ANGDAV 
1473 FORMAT (//52H *** ERROR - THE BOUNDARY ANGLES AT L.E. POINT Z = , 

1 F10.5,4H K =,F10.5//14X,1 7HARE NOT THE SAME. 

2 33H THE AVERAGE VALUE WILL BE USED.//21X,7HBDY = ,A6,6X, 

3 7HBOY = , A6/21X , 5HANGD= , F 8. 3 , 6X » 5HANGD® * F8 • 3// 29X , 

4 8HAVG-ANG=,F8.3) 

ANGbT ( LB ) = ANGOAV* TOR AD 

C MAKE ROOM FOR SUB I ABLE Of INCLUDED BOUNDARIES 

474 LUP = MAXO( l,LD/l(LBl) ) ♦ MAXO( 3 ,LBZ1 ( LB2 1) - LBZl(LBl) 

LB = LR1+LBZ I ( L H 1 ) 

“ LT LIULUP 

CALL MOVE I I, ZHT(LB) ,ZBT (LT) , LB+5-LBDE • I ) 

LBDE = L DDF ♦ LUP 

— I F ( LD 2 . GE . L B I ) LH2=LB2+LUP 

C INCLUDED BOUNDARIES IN COUNTOUR LB1 

__ IFlLBZl(LBl).NE.O) GO Tu 475 

BDNAME(LB)=BDT(LB) 

L B A ( L B ) = LUP 

L BB ( L B ) = LBA(LB)+LBNEXT(LB)-9 

— LB = LB+3 
GO TU 480 

475 LBN 1 = LB1 

_ 476 LBA(LBN1)=LBA(LHN1 )+LUP 

LBBILUNI )=LBB( LBN 1 ) ♦LUP 
LBN 1 = L BN 1 ♦ 3 

IF(LBNl.LT.LB) GO TO 476 

C UPPER SURFACE CHANNEL NAME IS STORED ON TOP OF -UP- 

C LEDEX = INDEX OF LEADING EDGE PT ON THE CONTOUR 

— 4 BO CHNAME(LBl*I)=CHNAME(LB2) 

LEDEX (LB1 ) =LBB(LB- 3) 

_ C INCLUDED BOUNDARIES IN CONTOUR LB2 

IF(LBZl(LB2).NE.O) GO TO 485 
BDNAME ( LB )=BDT( LB2 ) 

LBA(LB)=LBB(LR-3) 

” LBB(LB)=LBA(LB)*LBNEXT(LB2)-9 

GO TO 490 

C RELOCATE INDEX LIMITS OF UPPER BOUNDARIES 

— 485 L BN 2 = LB2 

LBDIF = LBB(LB-3)-LBA(LB2 ) 

4H6 BDNAMt ( LB )= BDNAME ( LBN2 ) 

LBA (LB ) = L BA ( LBN2 ) ♦LBDIF 

LBB(LB»=LBB(LBN2 ) +LRDIF 
LB = LB*3 

LBN2 = LBN2+3 

“ IF( LBN2.LT. (LB2+LBZ1 (LB2 )) ) GO TO 486 

C RELOCATE LB 2-COOR U I N A TE S INTU L B 1 -COUNTOUR . NB2=NUMBER OF DATA 

— C POINTS TO BE MOVED. 

490 NB2 = LBNEXT( LB2 )-LBZl ( LB2 ) -9 
LI * LB1+LBNEXT (LBl ) ♦ L UP 
_ LT LI+NB2 

L 2 = LB2+LBZ1(LB2)*9 

L22 = LB2+LBNEXT (LB 2.) 

I F( LB2 .LT .LBl ) GO TO 494 




LB2 * L82+NB2 

L 2 = L2+NB2 

L 22 3 L22+NB2 

*9* LBZ1(LBU=LB21(LB1 )*LUP 

LBNEXT (LB1 ) =LBNEXT (LB1KLUP+NB2 

CALL MOVE ( 3 » BDT < L I ) , BDT ( L T) , L I -1-LBDE . 1 , 

1 BDTl L2) *BOT (LI ) »NB2» 1 « 

2 BOT(L22l ,BOT(L82),LBDE*NB2*l-L22,l) 

L BDE * l BOE + NB2- ( L22-LB2) 

DO 495 LEX=LE0,LEE,10 
*95 IF(BDHLEX) .EQ.BD2) BDH LEX) 3 BD1 
*96 LE = L £♦ 10 

IF(LE.LT.LEE) GO TO *72 

BE TURN 

1*6B FORMAT < /1X70HERR0R- THE L.E., T.E. AND BOUNDARY POINTS CAN NOT BE 
♦ORDERED ACC0RDING/8X6AHT0 ORTHOGONAL NUMBER. PLEASE CHECK S.L. AN 
♦GLES IN TABLE-LETEPT. ) 

1365 FORMAT ( ///1X8H** TH£3X f A6« 1X25HB0UNDARY CONTOUR FOR CHN = A6 1 IX 17H 
♦IS NOT CONT INUQUS/6X9HAT POI NTSF 1 1 . 5 « 1 H » F 1 0. 5 , IX 3HANDF 1 1 . 5 . 1H , F 10 . 
♦5, 1H./6X59HTHE FOLLOWING TABLE CONTAINS THE BOUNDARY COORDINATE IN 
♦ PUT. ) 

END 


\ 






ZIM1) = Z ( M2 ) 

ILB(L2)=ISV 
FLB(L2)=FSV 
S1LB( L2 ) = SSV 
R ( M2 ) = RSV 
Z(M2) = ZSV 
GO TO 100 

~ C COINCIDENT ORTHOGONAL S 

Mb Ml = ML H ( L 1 ) 

NAMBDV = NAMELB( L 1 ) 

- GO TO IB 7 

C UPPER BOUNDARY 

_ 100 L 2 * L l*LNE XT ( L 1 ) 

L 65 IF(L2.GL.LESTA) GO TO 190 

IF(NAMEUB(L2) .EQ.NAMEUB( Lin GO TO 170 

L2 = L2+LNEXT ( L2) 

GO TO 165 

C NAME AGREEMENT 

170 IF( FLOAT! IUB(Li) )+FUB(Ll ) - FLOAT { IUB( L2 )) -FUBIL2 )) 180 , 185,190 

- C SWITCH POINTS 

100 Ml = MUB(Ll) 

M2 = MUBIL2I 

_ ISV = I UB (LI) 

FSV = FUB (LI) 

SSV = S 1UB (LI) 

RSV * R ( M 1 ) 

~ ZSV = Z ( M 1 ) 

I UB ( L 1 I = I UB ( L 2 ) 

FljB ( L 1 ) = F UH ( L 2 ) 

- S1UB(L1 )=S1UB(L2> 
o ( Ml ) = P ( M2 ) 

Z(Mi) = Z ( M 2 ) 

_ 1 UB ( L 2 ) = I SV 

FUB(L2)=FSV 
S 1UB ( L 2 ) = SS V 
R(M2) * RSV 

“ Z ( M2 ) = ZSV 

GO TO 190 

- C COINCIDENT ORTHOGUNALS 

105 Ml = MUB (LI) 

NAMBDY= NAMEUB ( L 1 ) 

187 ERR = .TRUE. 

WRITE (6,1187) Z (Ml) ,R(M1 ),NAMBDY 

C INDEX LI 

“ 190 LI = L 1 ♦LNE X T ( L 1 ) 

IF( Li.LT.LESTA) GO TO 60 
RETURN 

1107 FORMAT ( 45H *** ERROR - COINCIDENT ORTHOGONALS AT POINT « 2F10 .5 , 1 1H 
* ALONG BDY=,A6) 

END 




♦DECK BPSORT 

SUBROUTINE BPSORT 

♦BPSORT BOUNDARY POINT SORT -BPSORT- 

C FIELO TABLES 

C INDEX- M*MO , NM 

COMMON /CZ / Z ( 300 ) 

COMMON /CR / R ( 300 1 
COMMON /CS2 / S2I300) 

COMMON /CS1 / S 1 ( 300 ) 

COMMON /CPH 1 1 / PHI 1 ( 300 ) 

COMMON /CM / JMS( 300 ) 

COMMON /CCURV / CURVI300) 

COMMON /CB / 6(3001 

COMMON /CIOEX / M « J ,MU»MO, I S TAG 

COMMON /IXORIG/ LHO.LHE, LBDO.LBDfc, LTO, LTE * LWO,LWE, LFO,LFE, 
+ LO»LESTA * LDUMI8), 

♦ MO , NM , NJ,NFCOLS, MA XN J ,MAXOL , MAXNM, MAXLE , 

* LEO, LEE, LRO , LR E , LRD 

DIMENSION LIMITS(2*> 

EQUIVALENCE (LIMITS, LHOJ 

COMMON /SLTAB / W ( 12 8 I , X 2 ( 12 8 ) , SLCHN ( 1 28 ) 

INTEGER SLCHN 

COMMON /CHDATA/ X I ( 1 ) , LNE XT ( 1 > , ML B ( II , MOB (I) , PRI M (1 ) , 

1 TYPELBIl ) ,NAMELB( 1 ) , JLBI1 ) ,FLB(1 ) ,S1LB(1) , 

1 TYPEUB (1 ) ,NAMEUB( 1 ) , IUB( 1 ) , FUBll ) ,S1UB( 1) , 

3 VMB ( 1 ) »DWDV ( i l , X2CL ( i ) , VCL ( 1 ) ,MCL ( 481 ) 

LOGICAL PRIM 

INTEGER TYPELB, TYPEUB 
DIMENSION SC HOKE ( I ) 

EQUIVALENCE ( SCHOKE, DWDV ) 

COMMON /TROUBL/ ERR, ERRMA J, I NfcRR, PRERR 
LOGICAL ERR, ERRMA J, I NERR , PRERR 

C BEGIN LOOP THROUGH STATION TABLE 
LI * LO 


C 

C 

c 


LOWER BOUNDARY 
60 L2 * L 1+LNEXT (LI) 

65 IFCL2.GE.LESTA) GO TO 100 

IF(NAMELB(L1>.EQ.NAMELB(L2>> GO TO 70 
L2 = L2+LNEXT ( L2 ) 

GO TO 65 


NAME AGREEMENT 
70 I F ( FLOAT! ILBIL2) ) ♦FLB(L2 I 
SWITCH POINTS 
80 Ml = MLB(Ll) 

M2 = MLB( L2 I 

ISV = ILB(Ll) 

FSV = FLB(Ll) 

SSV = S1LBIL1) 

RSV * R ( M I ) 

ZSV * Z ( M 1 1 

ILB(L1)»ILB(L2) 
FLB(LI)-FLB(L2) 
SlLB(Ll)=SILB(L2) 

R ( Ml ) = R ( M2 ) 


FLOAT ( ILB(Ll) >-FLB(Ll I ) 60,85,100 




♦DECK FF1NIT 

SUBROUTINE FFINIT 

♦FFINIT INITIALIZATION OF FAR FIELD CALC 

COMMON /CISBOT/ F ARFLD ( 2 ) #FREE < 2 I ♦ PRES ( 2 ) , RFF ,NZP* 
1 ZPllOI.PPStlJ), A1 f A2* ADUMI6) 

INTEGER FARFLD*FREEtPRES 

RETURN 

END 


-FFINIT- 
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REAL 

LOGICAL 

LOGICAL 

COMMON /IXORIG/ 


♦DECK FREON/ 

SUBROUTINE FREON/ 

CERE UN/ GENERATE /ON, ZIJ MATRIX FOR FAK-FIELD BC. -FRFDNZ 

COMMON /AlLCOM/ M ACHA , PS A , TS A , P TA , T T A , AX I A ,RGA, GAMA , 

1 MACHC.PSC,TSC,PTC»TTC» AX l C , RGC, GAMC » 

2 DAxIT,SCALEA,TTE,CHQTST 

M ACHA ( 1> » MACHC 
A X I A « AXIC 
CHOTST 

L HO, LHE , LBOO.LBDE, LTO, LTE » LWO.LWE, LFO.LFE, 

♦ LO.LESTA, LDUM ( 8 ) » 

♦ MO.NM, NJtNFCOLSt MA XN J , MAXOL , MAXNM , MAXLE , 

♦ LEO, LEE, LRO,LRE,LRD 

DIMENSION LIMITS(24) 

EQUl VALENCE (LIMITS. LHO) 

STATION TABLE 
INDEX- L=LO,LESTA 

SCHOK E= STATION CHOKE INDICATOR ( AD J WF , BRHS , WR IOUT ) 

MCL = SHARP CORNER INDICATUK (BLDTBSI 

MCL = FIELD INDEX OF CONTROL STREAMLINE ( PTMOVE , FLOBAL ) 

COMMON /CHDATA/ X 1 ( 1 ) , LNE XT I l ) , MLB ( 1 ) , MOB ( 1 ) , PR I M (1) , 

1 TYPEL8U I ,NAMEL B ( I ) , ZLB(l) , FL B ( I ) , S I L B 1 1 ) , 

1 T YPE UB ( I ) . NAMEUB (l),IUB(l),FUB(l) ,S1UB(I), 

3 VMB( 1) ,DWDV( II , X2CL ( 1 ) »VCL(i)»MCL(48i) 

LOGICAL PRIM 

INTEGER TYPELB , T YPEUB 


DIMENSION 
EQUIVALENCE 
COMMON /ERASE2/ 


SCHOKE(l) 

( SCHOKE.DWDV) 

WSTAI 100) ,DI$P( 100) .WAKE ( 100) ,TT ( 100) ,PT I 100) , 

♦ LAM( 100) ,RGX{ 100) .C2CPXI100). DUM ( 534 ) , 

♦ 1NK25), IN2I25.2) , 

♦ NINT.MI21 ) ,EE 121) .KKC2D .XINT (21 ) . 

♦ Y I NT ( 2 1 ) * Z Z ( 2 1 ) 

REAL M , KK 

DIMENSION XlJ(25,25),VI JI25.25) 

EQUIVALENCE ( WS T A , X I J ) , 1 C 2CPX , Y I J ) 

COMMON /ERASE/ UN I T( 25,25 ) 

/CPI / PI, DUMP I (5) 

/CHITS / BITS, BLANK 
/CFRELD/ NFF.MAXFF ,ZFF (64) ,RFF(64) , 

ZDNI25) »DRDN ( 25 ) ,UDN (2 5 ) , Z I J ( 25 , 25 ) 

FGRX I 100 > 

(FGRX.ZIJ) 

ATINF.MINF.RFFREF.UINF.ZDNl.Z DN2 5 
MINE 
PDUMI26) 

DUM I S(30),ADUM(6) 

VELPOT , ICOB , NODENS ,C PTDUM 
R ( 300 ) 

EQUIVALENCE ( R1 ,R FFREF ) , ( R25 , ADUM I 2 ) ) 

LOGICAL DSIZE 

REAL Ml. M2, M3, M4 

DATA AKl.AK2.AK3, AKA, AK5/ 

♦ 1 • 3862944, .096663443, .035900924, .037425637, .0145119621/ 

DATA BK 1 , BK 2 » BK 3 , DK4 »BK5 / 

♦ .5, . i 24 9H 594, .068 8024 9, .033283 55, .00441 ZB 7/ 

DATA AE l , AE2, AE 3, AE4 / 

♦ .44325141, .06260601, .04757384, .01736506/ 


COMMON 

COMMON 

COMMON 


DIMENSION 
EQUIVALENCE 
COMMON /CFRFIN/ 


REAL 

COMMON 

COMMON 

COMMON 

COMMON 


/CPRINT/ 
/CISBOT/ 
/CPTMOV/ 
/CR / 
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DATA BE 1 * BE 2 » BE 3 » BE4/ 

* .24998368, .0920018, .04069698 ,. 005264496/ 


INPUT*** 

MINE = FREE STREAM MACH NUMBER . 

Z ON 1 , Z DN2 5 = STREAMWISE LIMITS OF FAR FIELO . 

RFFRfcF = NOMINAL RADIUS OF FAR FIELD . 

OUTPUT *** 

ZDNU-25) = SIREAMW1SE CO-ORDINATES FOR DN- FAR FIELD SOLUTION . 
Z I J ( 2 5 » 25 ) = Z MATRIX = (INVERSE OF YIJ»*XIJ- 
EXTENS ION FRACTION TO FF= ADUM(l) 

BETA = SORT ( i.-M INF**2) 

OBETA = l./BETA 
INITIALIZE DZ, ZDN TABLE 
TRANSFORM TO INCOMPRESSIBLE PLANE 
NDENS V= NODENS 
NODEN S= -1 

1 DZ FF = ZDN25-Z0NI 

Z DN 1 = ZDN1-ADUM( 1)*DZFF 

Z ON 2 5 = ZDN?5*ADUM(1 )*DZFf 
ZON €11= ZON l*OBE T A 
Z DN (25)= Z ON25*OBE T A 
DZ = (ZUN(25!-Z0NU))/24. 

DO 2 K = 2 * 24 

2 ZON(K )= Z DN ( K — 1 ) +DZ 

C DETERMINE FF CROSS STREAM COORDINATE AT ZDN ( 25 1 
L = LESTA-19 

I F ( LNEXT(L I.NE.20 ) CALL ERRORI 
MA = MLB(L) 

- MB MUB(L) 

CALL TTPT (MA,MB,WSTA,DISP,WAKE , TT , PT » L AM, RGX , C2C PX, FGRX ) 

NK = MB-MA+1 

_ C ASSUME ISENTROPIC PROCESS TO UNDISTURBED CONDITIONS AT ZDNI25) 

GM2 = . 5* ( GAMA- l • ) 

GMI = (GAMA-1. I/GAMA 

PSINF = PT (NK )/( I .+GM2*MINF**2)**( 1 • /GMI ) 

AREA = 0. 

K. =0 

11 11 K = K*l 

- GMA = ( l. + FGRX(K ) )/FGRX(K) 

GMI = 1 . / ( GMA*F GRX ( K ) ) 

TSOTT = ( PSINF/PT(K))**GMl 

_ V2 S0RT(C2CPX(K )*TT (K)*( I.-TSCTTI) 

RH02 = PT(K)/(RGX(K )*TT (K) )*TSQTT**FGRXIK) 

I F ( K.GT.l ) GO TO 1112 
WOAKM 1= RH02*V2 

- GO TO 1111 

1112 WOA = R HO 2 * V 2 

AREA = AREA+2.*(WSTA(K)-WSTA(K-l) I/I WOAKM i* WOA) 

- WOAKM 1 * WOA 

I F ( K.LT.NK ) GO TO 1111 
R25 = ARE A+R ( MA ) 

I F ( AXIA ) R25 = SO RT(R(MA)**2+ AREA/PI I 
I F ( .NOT. AXIA ) GO TO 94 
NINT = li 
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C INITIALIZE PARAMETERS FOR INTEGRATION 

3 DZZ = OZ/FLOAT (NlNT — 1) 

C NOTE ** ** RAO I AL CO-OROINATE SCALED****** 

USING = 0.1*RFFREF 
OSIZf = .TRUE. 

I F ( DZZ.LE.DSING ) 0 S I ZE = .FAL SE . 

FA = A . *RF FREF **2 
I F ( OSIZE ) DELZD=DZZ-DSING 
DO = AMINII DZZtDSING ) 

AL = ALOG I .125*00 ) 

SINGV = 2.*(-PI+DU*AL)-.l 25*1)0* *3* 1 1 • + AL ) 

C OUTER LOOP FOR CALC. OF XIJ,YIJ TABLES 
DO 90 1=1,25 

C INNER LOOP FOR CALC. OF XIJ,YIJ TABLES 
DO B9 J = 1 , 25 

SECTION TO BUI LO TA8LES FOR INTEGRATION 
TABLES ARE BUILT IN 2 PASSES 
KGO = 1 

I F ( I.EO.J ) GO TO 10 
I F ( J.EQ.l ) KG0=2 
I F ( J.EQ.25) KG0=3 
GO TO 12 
10 KGO = A 

I F ( J.EQ.l ) KGO= 5 
IF! J.EQ.25) KGO =6 
12 NIN = NINT 

I F ( KGO.NE.l .AND. KGO.NE.A ) NlN* (NlNT-1 ) /2*l 
NM I 0 = 0 

I F ( KGO.EQ.A ) NMID=ININT-l)/2*l 

C INITIAL PASS TO BUILD TABLES 

K =0 

15 K = K ♦ l 

K 1 a K-l 

C = l. 

GO TO ( 20,25,20,30,35, AO) , KGO 

C NORMAL BRANCH — OR (J=25, I.NE.J ) 

20 I F ( K.GT.i ) GO TO 22 

21 Z Z ( K I = ZDN I J )- . 5*0Z 
GO TO 23 

22 Z Z ( K ) * ZZ ( K 1 ) ♦C*DZZ 

23 MI K ) = FA/IFA+IZONI I J-ZZIK) )**2> 

GO TO 50 

C **( J x l» I .NEJ ) 

25 I F ( K.GT.i ) GO TO 22 
ZZ IK) * ZDNI 1 ) 

GO TO 23 

C NORMAL SINGULARITY BRANCH 

30 I F ( K.EQ.l ) GO TO 21 

IF! Z Z (K-l ) .NE. BITS ) GO TO 31 
K 1 = K-2 

C =2. 

31 IF! K .NE .NM ID ) GO TO 22 

32 ZZ(K) = BITS 


) 0 » 
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M ( K J = BITS 
GO TO 50 
C **( I=J, J = 1 ) 

)5 I F ( K.GT.2 ) GO TO 22 
GO TO (32,36) , K 
36 ZZ(K) = ZDN ( J ) +DZZ 
GO TO 23 

_ C **( I=Ji J = 25 ) 

40 I F ( K.E0.1 ) GO TO 21 
I F ( K.EO.NIN ) GO TO 32 
GO TO 22 

~ 50 I F ( K.LT.NIN ) GO TO 15 

C FINAL PASS TO BUILO TABLES" ADJUST FOR SINGULARITIES CLOSER 

- C THAN DZZ 

I F C .NOT. OSIZE ) GO TO 70 
K = 0 

55 K = K+i 

IF ( ZZ (K ) .NE.BI TS ) GO TO 60 
GO TO (60,60,60,56,57,56) , KGO 
“ 56 ZZ(K-n* ZZ(K-1 )*DELZD 

M(K-1)= FA/(FA+(ZDN( I )-ZZ(K-l))**2) 

I F ( KGO. EG. 6 ) GO TO 60 

- 57 ZZ(K+U= Z Z ( K ♦ 1 ) - DEL ZD 

M ( K •*■ l ) = FA/(FA+(Z ON ( I I -*Z Z ( «♦ 1 1 1 **2 I 
60 I F ( K.LT.NIN ) GO TO 55 

” C EVALUATE ELLIPTIC INTEGRALS IMMl.ECMU 

70 CO 71 l^i.nin 
I F ( M(l).EU.RITS ) GO TO 71 
Ml = l.-M(L) 

I F ( Ml. E 0.1. .OR. Ml.EO.O. ) CALL ERRORl 
M2 = M l *M 1 

M3 = M 2*M 1 

M4 = M2*M2 

TLOG = ALOG ( 1./M1 ) 

EVALUATE KK 

K K ( L ) = AK1+AK2*M1+AK3*M2+AK4*M3 + AK5*M4 

* ♦( BKUBK2*M1 + BK3*M2 + BK4*M3 + BK5*M4I *TLOG 

EVALUATE EE 

EE ( L ) = 1 .*AE 1*MUAE2*M2 + AE3*M3+AE4*M4 

* +( BE 1*MH-B12*M2+BE 3*M J+BE4*M4 ) *TLOG 

“ C 

71 CONTINUE 

- C CALCULATE INTEGRANDS X INT , Y-NT 

DO 73 K = 1 , N IN 

I F ( ZZ(K).EO.BITS ) GO TO 73 

DEN = SORT(FA+(ZDN( I )-ZZ(K) )**2) 

X I NT ( K ) = -4.*RFFKEF*EE ( K ) / ( DEN* < ZDN< I)-ZZ(K) I I 
V I NT ( K ) * -2.*(KK(K)-EE(K) )/OEN 




73 CONTINUE 
C iNTE GRATE 

75 X I J I =0. 

Y I J I = 0. 

K * l 

76 K = K ♦ 1 

GO TO <77,77,77,78,78,781 , KGO 

77 DZK a ZZ(K)-ZZ(K-l) 

T£RMX = 0 .5* ( XINT ( K ) +X INT f K-l ) )■ 

TERMY = 0.5*(YINT ( K ) f Y I N T (K-l )) 

X I J I * X I J I ♦ TERM X*DZK 

Y I J 1 = yiji+termy*ozk 

GO To 80 

c 

78 I F < (ZZ(K).NE.BITS) .ANO, ( Z Z ( K- 1 ) .NE . B I TS ) ) GO TO 77 
I F ( KG0.E0.6 ) GO TO 80 

I F I KGO.EO.A ) K = K +2 
I F ( KG0.EQ.5 ) K=K4l 
GO TO 77 
C 

80 I F ( K.IT.NIN ) GO TO 76 
X I J C I,J) = XIJI 

I F ( KG0.GT.3 ) YI JI*YI JI 4SINGV 

Y I J ( I , J )* Y I J I 

89 CONTINUE 

90 CONTINUE 

IF< PDUM( 26) .EO.O. ) GO TO 91 
CALL TABPRTI3HXIJ.XIJ,625,10) 

CALL TABPRT(3HYIJ,Y1J,625,10) 

91 CONTINUE 

C DETERMINE INVERSE UE YU 

CALL MATINV(YIJ,25,UNIT , 0,0E T,lNlt!N2«25,lSCALL) 

DO 93 1=1,25 
DO 93 J= 1 , 25 
Z I JU, J )= 0. 

DO 92 K= 1 , 25 

92 ZIJU,J)» ZIJU,J)4XIJ(I,K)*UNITtK,J) 

93 CONTINUE 

C TRANSFORM BACK TO COMPRESSIBLE PLANE 

GO TO 97 

94 CALL SETMt 1,0.,Z1J,625) 

DO 96 1=1,25 

DO 95 J=i,25 

IF! I.EQ.J ) GO TO 95 

DXIJP = ZDNU )-<ZON( J )4.5*0Z) 

DXIJM = ZDN ( I )- (ZON( J )-• 5*0Z I 
ZIJII,J)= -l./PI*ALOG(DXI JP/DXI JM) 

95 CONTINUE 

96 CONTINUE 

97 CALL FMPYC ( 1 , BETA , ZDN, ZDN, 25 ) 

CALL FMPYCI 1,0BETA,ZIJ,ZIJ,625) 

I F ( PDUM126I.EQ.0. ) GO TO 200 
CALL TABPRT ( 5HYIJ-1,UNIT ,625,10) 


CALL TABPRTt 3HZ I J , Z I J , 62 5, 10 ) 

200 N00ENS= NDENSV 

WRITE (6,211) Z0N1,RI,ZDN25,«25 

211 FORMAT( //6X,29H*EXTENDE0 FAR FIELD B0UNDARYV7X, 2HZ- »F10. 3, 3X, 
♦ 2HR=,F10.3/7X,2HZ*,Fl0.3f3X,2HR=,F10.3/) 

RETURN 

END 


\ 
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♦ nr ck iMjfjr 

MJBHljur INI I SHU I 

♦ IS Mfj I - INSMU SPEC 1 A L MUUNDAR Y TYPES 


STATION TABLE 
INDEX- L *LO , L £ S TA 

SCHOKfc= STATION CHOKE INDICATOR (ADJWF,8RHS,WRIOUT) 

MCL = SHARP CORNER INDICATUK ( BLDTBS ) 

MCL = FIELD INDEX OF CONTROL STREAMLINE ( PT MOV E , FLOBAL ) 

COMMON /CHDATA/ X 1 11) , LNE XT ( 1 ) ♦ MLB (i ) , MU8 ( 1 ) , PRI M ( 1 ) , 

i type lb 1 1 1 camels a > , nam ,flbu ) .silbi i ) , 

1 TYPEUB(1),NAMEUB(1),IUB{1),FUB(1),SIUB<1), 

3 VMS ( 1 ) ,D WDV ( 1 ) « X2CL (1) , VCL (1 ) .MCLI48I ) 

LOGICAL PRIM 

INTEGER TYPELB, TYPEUB 
DIMENSION SCHOKEUJ 

EQUIVALENCE < SCHOKE , D WDV I 

BOUNDARY TABLE 
INDEX- LB=LBDOtLBDE 
LBNEX T= INCREMENT TO NEXT BOUNDARY 

L6Z 1 = INCREMENT TO THE FIRST BOUNDARY POINT ( = 0 BEFORE COALL AT 1 0 

chname= channel with which the boundary data is associated 

UP = T OR F FOR UPPER OR LOWER BOUNDARY 

LEOEX = RELATIVE INDEX OF L.t. POINT WHEN LOWER AND UPPER SURFACE 
CONTOURS ARE CONNECTED 

BDNAME,LBA,LBB=NAME AND INDEX LIMITS OF SPECIFIC BOUNDARY 

DATA WHEN BOUNDARIES ARE COALLATED 
DIMENSION BDT( i».LBNEXT(l) ,LBZUi) ♦ 

1 CHNAME(I) ,UP< II ,LEDEX(1I ♦ 

2 ZBT(1)*RBT(II »ANGBT( 42 ) 

LOGICAL UP 

INTEGER BDT,CHNAME,BONAME 

DIMENSION BONAME (l),LBA(l),LBB(l) 


DI MENS ION 

INTEGER 

EQUIVALENCE 

1 

2 
3 


CHNAM( 1 1 t LHNE XT ( 1 1 
CHNAM 

( X ItBOT tCHNAM ) • ( LNE XT , LBNE XT , LHNEXT ) , < MLB , L BZ 1 ) » 

( MUB tCHNAME I . <PRIM,UPJ, ( TYPELB « LEDE X ) • 
(NAMEL8,ZBT#B0NAMEJ. < I LB , RBT , LB A ) , { FLB f ANGBT f 
LBB) 


COMMON /IXORIG/ 

* 


* 

* 


DIMENSION 

EQUIVALENCE 


L HO, LHE , LBDOyLBDE * LTO,LT£ f LWO.LWE, LFO.LFE, 
LOtlESTA, LDUM (81, 

MO »NM, NJtNFCOLSt MAXN J , MAXOL , MAXNM, MAXLE , 

LEO, LEE , LRO» LRE» LRD 
LIMITSI24) 

( LIMITS, LHOI 


COMMON /CFRFIN/ 
REAL 

COMMON /CIDEX / 
COMMON /CISBOT/ 

1 

INTEGER 

COMMON /TROUBL/ 
LOGICAL 


ATINF»MINF,RFFREF*UINF,ZDNl » ZDN2 5 
MINF 

M, J,MU,MD,ISTAG 

FARFLD (2 ) ,FR EE (2» ,PRES ( 2 ) ,RFF ,NZ P , 
ZP(iO) •PPS(IO), A 1 , A 2 » ADUM ( 6 I 
FARFLD, FREE, PRES 
ERR,ERRMAJ, INERR, PRERR 
fcRR,LRRMAJ,INERK,PRERR 
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BFAS 

SUBROUTINE BF AS ( X , Y, ANG, S ,KA , KB I 

BEAM FIT EVALUATION OF ANGLE AND S -BFAS” 

DIMENSION XI 10) ,Y( 10), ANG (10 I ,S(I0) 

INPuT- 

X , Y - COORDINATES 
ANG - ANGLE IN RADIANS (IF MA=1) 

ANG I 1 ) = ESTIMATED ANGLE AT THE FIRST POINT (MA«0) 

K A * KB - FIRST AND LAST INDEX OF VARIABLES X,Y,ANGtCURV,E AND S 
KD - STORAGE INCREMENT OF X , Y , ANG ,CURV ,E , AND S 
KORDER* 0 IF ERROR 1 IS TO BE CALLED WHEN PTS ARE OUT OF ORDER 
= I IF RETURN IS TO BE MADE FOR CORRECTIVE ACTION 
= -1 IF POINT ORDER CHECK IS TO BE SKIPPED 

OUTPUT - 

ANG - ANGLt IN RADIANS 

S - ARC L ENG IH ALONG THt CURVE, (LI 

KOROL R= INDEX OF <>NU OF ADJACENT OUT-OF-ORDER PTS ( = 1 ON ENTRY!. 
COMMON /CREAM / MA ,MH , KD , KORDER 

COMMON /ERASE / A I 3 ) , B ( i ) , YPB 1 1 ) , DA (1) , ACHD (11 ,CHD ( 793 1 
NK = KB 

CALL BEAMIX(KA) , Y ( KA ) r ANG (KA I , < KB-K A +K D) / KD > 

IF (KORDER. NE.O) GO TO 800 

C (K=KA) 

SK = S ( K A ) 

~ C ( K =KA ♦ 1 » KB ) 

I = 9 

K = K A ♦ K 0 

— 70 SK = SK ♦ CHU( I-8)*B( I -8 ) - . 5*B ( 1-8 I *YPB ( I -8 ) ♦ 

1 YPB( I-B|*YPB( 1-8 II/I5.) 

S ( K ) = SK 

_ IF(K-NK) 80,900,900 

80 I = 1*8 

K = K+KD 

GO TO 70 

C OUT OF ORDER POINTS 
800 KOROER= KA+KORDER-KD 

900 RETURN 
END 



♦ OECK 
♦BFAS- 
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* l)R Ck f AkRt U 

SUBROUTINE EARFLD 

CFARRLD computation of velocity on far field boundary -farfld 


C'JNM.JN /CR / 
COMMON /IXORIG/ 

* 

* 

* 

I ) I Ml NS ION 
f UUI VALI NCR 
SI AT ION TABLE 


K < 3D j ) 

L HO * LHE * LBDU»LBDE » LTO,LTE, LWO.LWE* LFO»LFE, 
LO.LESTA, LOOM ( 8 ) , 

MO , NM , NJ.NFCOLS, MA XN J , MAXOL , MA XNM , MAXLE , 

LIU, LEE, LRU.LRfc.LRD 
L I M I T S ( 2 4 ) 

(LIMITS* L HO I 


INDEX- l. 3 L U * L I STA 

SCHIJKR= STATION CHUKL INDICATOR ( AD J WF , BROS * WR IUUT ) 

MCL = SHARP CORNER INDICATOR (BLDTBS) 

MCL = FIELD INDEX UE CONTRUL STREAMLINE ( PTMOVE , FLOBAL ) 

COMMON /CHDATA/ X 1 ( 1 ) , LNE XT ( * I * ML B ( 1 ) , MUB (II , PR I M (1) ♦ 

1 TYPELB ( 1 ) * NAMELB ( 1 ),ILB(1)*FLB(1),S1LB(1), 

1 TYPEUB ( 1 ) ,NAMEUB( L ) • I UB ( 1 ) ♦FUBll ) ,S1UB( 1 ) , 

3 VMti ( 1 ) ,D WDV ( i ) . X2CL(1)»VCL(1)»MCL(*»81) 

LOGICAL PRIM 

INTEGER TYPELB,! YPEUB 
DIMENSION SC HOKE ( 1 ) 

EQUIVALENCE ( SCHOKE , DWDV ) 

COMMON /CL / L ( 300 ) 

COMMON /CFRFIN/ A T IN F * M I NF * RF FREF , UI NF , ZDN 1 , ZDN2 5 
COMMUN /CFRFLD/ NF F , MA XF F , ZFF (64 ) , RF F ( bk ) , 

* ZDN(2b) ,DKDN(2b> ,UI)N(2b) f 11 Jl 2b f 25) 

COMMON /CIDEX / M * J * MU , MO , I S I AG 
COMMON /CPHIi / PHI 1 ( 300 ) 

COMMON /CPRINT/ PDDOM ( 16 ) , PKF E , PRF F 1) , PRF F I . PDDDOM ( 7 ) 

COMMON /ERASE / L DOM ( Til I , PH I FF ( 64 I , KON< 2 b ) 

COMMON /Cl SHOT/ DUM I S ( 30 ) * ADUM( 6 ) 

EQUIVALENCE (R l, HE FREE I* <R25,ADUM(2I I 
EQUIVALENCE ( Z1 , Z0N1 ) , U2b f ll)N2b) 

INPUT*** 


FIELD TABLES R*Z 
VALUES OF M ON OUTER STREAMLINE 
Z MATRIX FROM ON SOLUTION OF FAR FIELD 
OUTPUT *** 

TABLt OF UDN VS ZDN 

PRE F 1 = 0 USE LF IT1 (NORMAL ) PRFFI = 1 USE LSPFIT FROM PHI1 


GET R , Z VALUES FROM FIELD TABLES (OUTER STREAMLINE) 

L = LO 

1 M = MBEGIN(NJ) 

CALL S T ANO ( M* L » UPPER ) 

DATA KFAR/6HF ARFLD/ 

IH TYPLUB(L ) .NE.KEAK ) RETURN 
NE = 'J 

2 NE = NF + I 

RFF(NF)= R ( M ) 

Z F F ( N F ) = Z ( M ) 

PH I FF ( NF J = PHIKM) 

CALL GET I X 
M = MD 

I F ( M.NE.O ) GO TO 2 
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♦ OECK BF At 

SUBROUTINE BF AC ( X , Y, ANG, CURV , NK ) 

*BF AC— BEAM FIT EVALUATION OF ANGLEt CURVATURE -BFAC- 

01 MEN SION X( 10) ,Y( 10) , ANG(IO) ,CURVU0> 

INPUT- 

X * Y - COORDINATES 
ANG - ANGLE IN RADIANS ( I F MA=1> 

NK * LENGTH OF X , Y , ANG ,CUR V-L I S TS 

OUTPUT- 

ANG - ANGLE IN RADIANS 
CURV - CURVATURE 

COMMON /CHI AM / MA ,MH , KO 

COMMON /LRASt / A ( i ) ,B (1) * YPH (1) • DA ( 1 ) , ACHD ( 1 ) tCHD( 79 3) 

CALL BEAM(X,Y,ANG,NK) 

I = 1 

C KA =1 

KB = ( NK-1 )*KD+1 

K * 1 

C ( K =KA » KB- 1 ) 

60 CURV ( K ) = U.*B( I )+2.*YPB(I) ) / ( C HD < I > * < 1 . *1 . 5* B (I ) *B < I ) ) ) 

80 I = 1*8 

K « K+KD 

IF(K-KB) 60,90,90 

C (K=KB) 

90 CURVtK I-B)-4.*YPH( 1-8) )/<CHD( 1-8 ) * ( 1 . ♦! . 5*YPB( 1-0 ) *YPB ( I 

1 «) ) ) 


RETURN 

END 
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•DECK f 1 F ACS 

SUBROUT [Nt BF AC S ( X , Y , ANG * CUR V , S , K A V KB J 
♦BFACS- BEAM FIT EVALUATION OF ANGLE, CURVATURE, -BFACS- 

C AND S 

H I MEN SION X (10 ) » Y ( 10) , ANG ( 10 1 ,CURV ( 10) ,S( 10) 

INPUT- 

X,Y - COOkO INA TL S 

ANG - ANGLE IN RADIANS (IF MA=1) 

ANG ( 1 ) = ESTIMATED ANGLE AT THE FIRST POINT (MA«0) 

K A , KB - FIRST AND LAST INOEX OF VARIABLES X , Y , ANG , CURV , E AND S 
KD - STORAGE INCREMENT OF X , Y , ANG , CURV , E , AND S 

OUTPUT- 

ANG - ANGLE IN RADIANS 
CURv - CURVATURE 

S - ARC LENGTH ALONG THE CURVE, (L) 

COMMON /CBEAM / M A , MB , KD 

COMMON /ERASE / A ( 3 ) ,B ( 1 ) , YPB ( 1 ) ,DA ( 1 ) , ACHDC i ) ,CHD ( 79 3 ) 

NK = KB 

CALL BFAS(X,Y,ANG,S,KA,KB) 

I = 1 

K = KA 

C (K=KA,KH-1) 

60 CURV(K)= (A.*B( I ) ♦ 2 • * YPB ( I ) ) / (CHD ( I )*li«+l»5*B(I)*B( I ))) 

80 I = 1+8 

K = K*KD 

IF(K-NK) 60,90,90 

C (K=KB) 

90 CURV< K )=(-2.*B( I-H)-4.*YPB(I-8) ) / I CHDf 1-8) *( l •♦& .5*YPB( I -8) ♦YPB (I 
1 8 ) ) ) 


RE I URN 
END 




CALL .;fl 

r > = /hti I)«zm 

Ki\) = KKT ( I) + KM 

ANGL) = angchd+angm 

CUKVO = CUKVM 
S10U = SIM 

FD = F 

INTVL = (I - ( LH+LBZ 1 ( LB ) ) ) / 3 ♦ 1 


RtTURi-4 

EMD 
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bF 3 

SUBROUTINE BF 3 ( X , Y , ANG . C UR V, IA.IB) 

CENTRAL 3 -POINT CURVATURE 
DIMENSION X ( 10 ) , Y( 10 J , ANGt 10 ) ,CURV( 10 ) 

COMMON /C BEND / N»CH ( 2 ) , ANGE I 2 ) .CURVE I 2 ) ,FB < 2 ) 
DIMENSION ANGX ( 3 ) .CURX ( 3 ) 

NhCBl l ) -U 
NBC (3 ( 2 ) =0 
1BM2 = IB-2 
ANCX ( i ) =0. 

If ( I BM2.I T . 1 A ) RETURN 
DO i 10 1= I A, I ItM 2 

CALL iif AC ( X ( I ) , Y( I ) , ANGX , CUR X ,3 ) 

ANG ( I ♦ 1 ) =ANGX ( 2 ) 

CUR V ( l ♦ 1 ) =COR X ( 2 ) 

RE TURN 
V NO 



-BF3- 
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♦ DECK. BOY P T M 

SJHK0UT1NL HOYPTMCNAMEtlNTVL, ZD , RD, FD , SI OD ,DS 1. DS1 GMA > 
♦bUYPIM BOUNDARY POINT MOVEMENT -BDYPTM- 


1NPIJI - 

i'UT s BOUNDARY I AB| l 


KAMI ^ BOUNDARY NAMI 

PJTVL = INOIX (II INTERVAL OF JHfc INPUT PUINT IN THE BOUNDARY IAI3LE 

f r J = ERACTION POSITION Of THE INPUT POINT IN THE INTERVAL 

SiOU = ARC DISTANCE FROM THE BEGINING UF THE INPUT INTERVAL 

DSI = REU-D MOVEMENT IN THE CLOCKWISE DIRECTION FROM THE INPUT P 


OUTPUI - 

INITVL = INDEX OF INTERVAL OF THE OUTPUT POINT 

Z D » KD = COORDINATES OF THE CALCULATED OUTPUT POINT 

ANGD = ANGLE OF OUTPUT POINT 

CJRVD = CURVATURE OF OUTPUT POINT 

FD = FRACTION POSITION IN THE OUTPUT INTERVAL 

SiDD = ARC DISTANCE FROM THE BEGINING OF THE OUTPUT INTERVAL 

DS1GMA* -GET- MINUS -ASK- POINT MOVEMENT DISTANCE 


BOUNDARY TABLE 
INDEX- L B = L BOO * LBOE 

L B N L X I = INCREMENT TO NEXT BOUNDARY 

LBZ1 = INCRIMENT TO T ML FIRST BOUNDARY POINT ( = 0 BEFORE COALL AT 1 0 
CHNAME.* CHANNEL WITH WHICH Till BOUNDARY DATA IS ASSOCIATED 
UP = T UK I HJK UPPER UR LUWER BOUNDARY 

LEDEX = RELATIVE INDEX OF L.L. POINT WHEN LOWER AND UPPER SURFACE 
CONTOURS ARE CONNECTED 

BDNAML t LBA,LBB=NAML AND INDEX LIMITS OF SPECIFIC BOUNDARY 

DATA WHEN BOUNDARIES ARE COALLATED 
COMMON /CHDATA/ BDT ( II , L BNEX T Cl) , LBZ l Cl) , 

1 CHNAME (1),UP(1)»LEDEX(1), 

2 ZBTIl) *RBTC 1 ) f ANGBTC42) 

LOGICAL UP 

INTEGER BDT , CHNAME » BDNAME 
DIMENSION 
EQUIVALENCE 

COMMU.NI /CBEAM2/ 

1 

LOGICAL 

COMMON /IXUKIG/ 

* 

♦ 

* 

DIMENSION 
EQUIVALENCE 
COMMON /CBDYP T / 

COMMON /CBITS / 

E = FD 

SID = SIDD 

IFCF.EQ.O. .OR. 

DSIGMA= 0. 

C SEARCH FOR MATCHING BOUNDARY NAME 
Lb = LBF ( NAME ) 

IF(LB.EQ.O) CALL ERR0R1 


BDNAME ( i ) »LBA ( l ) ,LBB Cl > 

(BDNAME, ZBT) , C LBA , RBT ) , ( LBB » ANGBT ) 
DR,DZ,YPA,YPb,F ,G» D X , YQDX , ZM, RM , ANGM, CURVM, SIM, 
RZONLY, ANGCHD, S1NTVL, YPASO, YPAB*YPBSO 
RZONLY 

L HO, LHE , LBDU ,L BDE , LTD, LTE , LWO,LWE, LFO.LFE, 
L()»L tSTA , LijUM(B), 

Ml) ,NM, NJtNFLOLS. MA XN J , MA XOL , MA XNM , MAXLE , 

LEO, LEE, l RO , L.RE , LRU 
L I MI TSC24 ) 

CL I M 1 I S • L HO ) 

AN GO, CUR VD 
HITS, BLANK 


F.EQ.l.) F=BITS 




o n o 


I 


INDEX OF POINT WHICH 

BEGINS THE INTERVAL 

SF I 

= 

DISTANCE FROM POINT 

( 1) 

SFIPl 


DISTANCE FROM POINT 

( I + l) 

MINI 


LIWLHZl(LB) 


I 

= 

M I N I ♦ 3* ( INTVL-1) 


MAX 1 


LB-UBNEXT (LB )-l2 



r» CALL H ARC ( I ) 

C IK -I- IS THf T IRST UK A IJUUBLL POINT , BACK UP TO PREV INTERVAL 

IK (SINTVL .NE.O. ) GO TO 80 
1=1-3 
KL> = l. 

IN I .L r .MINI ) CALL ERROR 1 
(.0 TO 75 

HU IfOD.tO.l. .UR. S1D.GT. S INT VL) SlU'SINTVL 
SKI = DSHS1D 
SFIP1 = SKI-SINTVL 

C IS THt NbW POINT WITHIN THIS INTERVAL 
1J0 IF(SFl) 120,114,114 
114 IF(SFIPl) 160 ,160,140 

C (MOVE COUNTERCLOCKWISE) 

120 IF ( I .GT.MINI I GO 10 125 
DS1GMA=-SFI 
SF I =0. 

GO TO 230 
125 1 = 1-3 

F * BITS 
SFIPl = SF I 
CALL t)ARC ( I ) 

SF I = SFIPI+SINTVL 
GO TO 100 

C (MUVt CLOCK WISt) 

140 IF< I.LT.MAXI ) GO 10 145 
0S1GMA= -SFIPl 
SF I = SINTVL 
GO TO 230 
145 I * 1+3 

F = BITS 

SF I = SFIPl 
CALL BARC(I) 

SFIPl = SFI-S1NIVL 
GO TO 100 

C CALCULATE COORDINATES OF THE NEW POINT (PROPER INTERVAL FOUND) 

160 I F ( F.EO.BITS) GO 10 230 
1FIDS1) 210,220,220 
210 F = F + SF I / S 10 

GO ID 250 

22 j F = ( l SFI-SlD)+( SINTVL-SF 1 »*F ) /( SINTVL-S1D) 

GO TO 250 

C (NEW INTERVAL) 

230 F = SF I /SINTVL 

250 G = l.-F 

RZONLY= .FALSE. 



/ 



o o o oooooo 


♦DECK ADPTSL 

SUBROUTINE ADPTSL ( Ml ,MU1 , HOI , Jl »NE WSL ) 

♦AOPTSL ADD A POINT ON THE NEW STREAMLINE -ADPTSL- 

LOGICAL NE WSL 

INPUT- 

MI = FIELD INDEX OF THE NEW POINT 

MU I = UPSTREAM-M FOR NEW POINT 

MD1 = DOWNSTREAM-M FOR NEW POINT 
Jl = INDEX OF SL OF THE NtW POINT 
NEWSL = T IF A NEW SL, =F OTHERWISE 

ACT I ON- 

I F ( NE WSL = T ) RELOCATE FOR NEW STREAMLINE IN SL-TABLES 
RELOCATE FOR NEW POINT IN FIELD TABLES AND CORRECT POINTERS IN JMS 


COMMON /IXORIG/ 

* 

* 

♦ 

DIMENSION 
EQUIVALENCE 
COMMON /SL TAB / 
INTEGER SLCHN 
COMMON /C IDE X / 


LHO.LHE, LBDO,LBDE, LTO»LTE , LWO,LWE, LFO.LFE, 
LO »L E ST A , L0UM<8), 

MO »NM , N J tNFCOLSt MA XNJ * MAX OL » MAX NM, M AXLE » 

LEO* LEE » LRO»LRE*LRD 
LIMITSI24I 
(LIMITS, LHO) 

W( 128 ),X 2 (128), SLCHN (128) 

M, J,MU,MD,ISTAG 


C ADJUST STREAMLINE TABLE 

JSAV = 999999 
IF ( .NOT. NEWSL ) GO TO 100 
J = J 1 

NMOVE = J-NJ-1 

CALL MOVE ( 3 , W ( J > , W ( J ♦ 1 ) , NMOV L ,D , 

I X2(J),X2(J+1), NMOVl ,D, 

^ SLCHN( J) ,SLCHN(J+l ), NMOVE, 0) 

NJ = N J ♦ 1 

JSAV = J 

C RELOCATE FIELD POINTS AND CORRECT JMS-CHAIN 

100 CALL ADDFPT(Ml, 1, JSAV) 

C INSERT POINTERS IN 

M = MI 

MU = MU 1 

MD = MD1 

J = Jl 

ISTAG = 0 

CALL SAVIX 

C CORRECT UPSTREAM TO DOWNSTREAM POINTER 

M = MU 

I F ( M ) 120,900,120 
I?0 CALL GETIX 
MD = Ml 
call SAVIX 
900 RETURN 
END 


HE JM S-TABLE 


\ 


■A 



o r> o 


-BARCS- 


*I)LCK M AH (. !, 

FUNCTION MARCSINAMf. , I VI, I V2 ) 

• MARCS- ACR DISTANCE BETWEEN BOUNDARY PTS 

INPUT- 

NAME = BOUNDARY NAME 

I V 1 , I V2 = INDEX of points in the given boundary 
c boundary table 

C INDEX- LB=lBDOfLBOE 

C LBNEXT= INCREMENT TO NEXT BOUNDARY 

C LBZ1 = INCREMENT TO THE FIRST BOUNDARY POINT (=0 BEFORE COALLATIO 

C CHNAME= CHANNEL WITH WHICH THE BOUNDARY DATA IS ASSOCIATED 

C UP = T OR F FOR UPPER OR LOWER BOUNDARY 

C I EOEX = RELATIVE INDLX Of L.L. POINT WHEN LOWER AND UPPER SURFACE 

C CONTOURS ARF CONNECTED 

C BDNAML i LBA ,LBB*NAME AND INDEX LIMITS OF SPECIFIC BOUNDARY 

f. DATA WHEN BOUNDARIES ARE COALLATED 

COMMON /CHDAT A/ BUT ( 1 ) ,LBNEXT ( 1 ) ,L0Z1 (1) , 

1 CMNAMEUI .UP(1) .LEOEXdJ , 

2 ZBT(1)*RBT(1) »ANGBT I 42 ) 

LOGICAL UP 

INTEGER BDTtCHNAME ♦ BONAMJ 

DIMt NS I UN BDNAME ( 1 ) ,LB A (1) , L BB ( 1 ) 

EQUIVALENCE ( MDNAME , ZBT ) , (LBA.RBT), ( LBB » ANGBT ) 

COMMON /CBEAM2/ OR ,0 Z , YP A , YPB *F ,G , DX ♦ YQDX , ZM ,RM , ANGM.CURVM, S LM , 

1 RZONLY, ANGCHD, SI NTVL ♦ YPASQ, YPAB, YPBSQ 

LOGICAL RZONLY 

C INDEX- M=MO » NM 

COMMON /CZ / Z ( 300 ) 

COMMON /CR / R ( 300) 

COMMON /CS2 / S2I300) 

COMMON /CSi / SI (300) 

COMMON /CPHI1 / PHI 1 (300) 

COMMON /CM / JM S ( 300) 

COMMON /CCURV / CUKV(300) 

COMMON /CM / M ( 300 ) 

COMMON /(. I Of X / M, J,MU,MD,ISTAG 

C INDEX IN /BDYTAB/ 

LB = LBF ( NAME ) 

C SUM THE ARC DISTANCES FOR INTERVALS IVI TO (IV2-1) 

I = L B + LHZ l ( L B )♦ 3* ( IVI-1! 

IF ( ISTAG.EQ.l ) 1=1*3 
I S TOP = I *3* ( I V 2— IVI) 

S =0. 

75 I F ( I-IST0P)80*90»90 
80 CALL BARC ( I ) 

S = S+SINTVL 

I =1*3 

GO TO 75 
90 BARCS = S 

*>> 


RETURN 

END 



IF(NM-H) 100(130*130 


180 RETURN 
END 




o o o n 


-ADJSI- 


♦OFCK AOJSt 

SUHKUU T INF ADJSL 

•ADJSL- ADJUST STREAMLINES BY DS2 


INPUT- 

/ » R = COORDINATES ALONG THE STREAMLINE 
PH 1 1 = STREAMLINE ANGLES 

US2 = DESIRED POINT MOVEMENT IN THE NORMAL DIRECTION 


C OUTPUT - 

C. 7,R = ADJUSTED COORDINATES 


COMMON /IXORIG/ 


DIME NS ION 
EQUIVALENCE 
COMMON /CBITS / 
COMMON /CDS2 / 
COMMON /CINNER/ 
COMMON /CMAXIT/ 
LOGICAL 

COMMON /CPHU / 
COMMON /CR / 
COMMON /CZ / 


L HO» LHE » LBDO tLBDE , LTOtLTE, LWO.LWE, LFO, LEE* . 
LO.LESTA, LOOM (8), 

MO ,NM , N J f Nf COL S , MAXNJ,MAXf)l , MAXNM.MAXLE , 

LEO, LEE, LHO,LRE,LRD 
L I MI TSI24) 

(LIMITS, LHO) 

B I TS, BLANK 
DS2( 300) 

I NRCTR,RDUM,N INNER (16) ,CNVF(16) 

MAXI T.MAJCTR, GREF IN, EDUM 
GREF IN 

PHIK300) 

Rl 300) 

Z( 300) 


CNF = CNVF(MAJCTR) 

M = 1 

1050 R ( M ) = R(M) ♦ DS2(M)*C0S(PHI1(M))*CNF 
Z ( M ) = Z(M) - DS2(M)*SIN(PHIKM))*CNF 
M = M ♦ I 

IF(M.LE.NM) (,() TO 1050 

RETURN 

END 




150 WRITE (6,1150) ( J , X2 ( J ) , SLCHN (J ) , W ( J ) , J»1 ,NJ) 
CALL TABPRT(5HERASE,ERASEC,800,5) 

CALL JMSPRT 

CALL TARPRT(2HS1« S1»NH, 10 ) 

CALL TARPRK2HS2,S2, NM, 101 
CALL TAHPRK 1HZ,Z,NM,10) 

CALL TAHPRK 1HR,R,NM, 10) 

CALL TAHPRK AHPHI l ,PHl l,NM, 10) 

CALL I ARPKK AHCUKV,CURV,NM, 10) 

CALL TABPRT(2HVH # VH*NM,10) 

CALL TARPRK 1HR,R*NM, 10) 

CALL TABPRT(6HERASE2fAREA,15 36t 8) 

L S TOP = 5 

GO TO (999,999) , LSTOP 
999 RETURN 

1150 FORMA T( ///1X17H STREAMLINE TABLE-/17X32HJ X2 

♦ W/( 1 18,F12.6,6X,A6,F 12.6, ), ) 


SLCHN 



o n o o o r> 


♦DECK ADDFPT 

SUBROUTINE ADDFPT ( IN S . NP T S » J SAV I ) 

♦ADDFPT ADD FIELD POINTS -ADDFPT- 


C 


C 


INPUT- 

INS = FIELD INDEX OF FIRST POINT TO BE RELOCATED, INDEX OF 
FIRST NEW POINT 

NP T S = NUMBER OF POINTS TO BE INSERTED 

JSAVL = INDEX VALUE OF NEW SL ABOVE WHICH THE FIELD J-REFERENCES A 
TO BE INCREMENTED BY ONE, "999999 IF NO CHANGE IS TO BE MA 


COMMON /IXORIG/ 

* 


* 

* 


DIMENSION 
EOUI VALENCE 


L HI), LHE , LHDU ,LBDE , LTO, LTE , LWO.LWE, LFO.LFE, 
LU.LESTA, LUUM(B), 

MO ,NM , N J , NFCUL S , MA XN J , MAXOL , MAXNM , MAXLE , 

LEU, LEE, LRO,LRE,LRD 
L I M I TS ( 2 A J 
(LIMITS, LHO) 


COMMON 

/CB 

/ 

COMMON 

/CM 

/ 

COMMON 

/CPH I 1 

/ 

COMMON 

/CR 

/ 

COMMON 

/CS1 

/ 

COMMON 

/CS2 

/ 

COMMON 

/CVM 

/ 

COMMON 

/Cl 

/ 

COMMON 

/CIOEX 

/ 

M 

= INS 


NP T 

= NPTS 


JSAV 

= JSAV1 



B< 300) 

JM S ( 300) 

PH 1 1 ( 300 ) 

R ( 300) 

SI (300) 

S2 ( 300 ) 

VM( 300) 

It 300) 

M,J,MU»MD,ISTAG 


RELOCATE FIELD POINTS 
NMOVE = M-l-NM 
MTO = M + NPT 

CALI MOVE < 3, 7 (M) , / (MTU) , NMOVE ,D, 

1 RIM) ,R(MTO), NMOVE, D, 

l B(M),B(MTO), NMOVE, D) 

CALL M0VE(3,S2(M) ,S2 (MTO) , NMOVE, D, 

3 SI(M) ,S1(MT0), NMOVE, D, 

A VM(M) ,VM(MTO), NMOVE, D) 

CALL MOVE ( 1, JMS(M) ,JMS (MTO) , NMOVE , D) 

RELOCATE FLOW ANGLES WHEN INSERTING NEW ORTHOGONAL LINES 
IF ( JSAV.EO. 999999 ) CALL M0VE(1, PH 1 1 ( M ) , PH 1 1 ( MTO ) , NMOVE , D ) 
NM = NM+NPT 


C CORRECT THE JMS-CHAIN 
MSAV = M 
M * l 

130 CALL GET I X 

IF(MU-MSAV) l AO ,135,135 
135 MU = MU+NPT 

1 AO I F ( MD-MSAV ) 150,1A5,1A5 
IA5 MD = MD+NPT 

150 IF(J-JSAV) 160,155,155 
155 J = J*1 

160 CALL SAVIX 
M = M + i 





noooooooo 


♦DECK ERRORY 

SUBROUTINE ERROR 1 

CEDUMPX EDUMP FOR STC EXECUTE SECTION -EDUMPX 


CS 


C 

C 


ALLCOM 
COMMON /ALLCOM/ 

1 

2 

REAL 

LOGICAL 

LOGICAL 

COMMON /CFB / 


LOGICAL 

COMMON /ERASE / 
COMMON /ERASE 2/ 

1 

2 
2 

REAL 

DIMENSION 

equivalence 

DIMENSION 
EQUIVALENCE 
FIELD TABLES 
INDEX- M=MO « NM 
COMMON /Cl / 
COMMON /CR / 
COMMON /CS 2 / 

COMMON /CS1 . / 

COMMON /CPHI1 / 
COMMON /CM / 
COMMON /CCURV / 


MACHA, PS A ,TSA ,P TA , TTA, AXI A ,RGA, GAMA, 

MACHC»PSC ,TSC »P TC , TTC » AXI C ,RGC, GAMC , 

DA XI T,SCALEA,TTE ,CHOTST 
MACHA(l) t MAC HC 
AXIA ,AX 1 C 
CHOTST 

L , MA ,MB , PLB , PUB , WF , CHOKE , SUBSON, NK , PLBC , PUBC , 
XCHOKE, T AREA , VMBC , WRQST.WCALC, QV(8 I , QVP ( 8 ) , 
J SUM , VMLBSO 

CHOKE, SUBSON 

ERASEC ( 800 ) 

AREA (96) , ARE A0( 96) ,0 1 SP ( 96 ) , PT (96 ) , LAMBDA ( 96 ) , 
RHO( 96),SQRTVV(96) ,TS ( 96) , TT ( 96) , VMSQ( 96 ) t 
V VKOKP ( 96 ) , 

W0A(96)»WSTA(96), RG ( 96 ) , C2CP 1 96 ) ,FGR(96) 
LAMBDA 

E S2( 96 ) , SDNQRM( 96 ) 

(ES2,VVKQKP) , (SDNQRM, RHO) 

RCU( 96 ) 

(RCU, LAMBDA) 


2(300) 

R ( 300 I 
S2 ( 300 ) 

SI (300) 

PH 1 1 ( 300 ) 
JMS( 300) 
CURV ( 300 ) 


c 


c 


COMMON /CB / U ( 300 ) 

COMMON /CIOEX / M,J,MU»MD»ISTAG 

TABLE OF INDEX LIMITS 

COMMON /IXORIG/ LHOfLHE, LBDO »LBDE , LTO,LTE » LWO,LWE, LFO,LFE , 

* LQfLESTA , L0UMI8), 

* MO , NM f NJ.NFCOLS, MA XN J , MA XOL , MAXNM , MAXLE , 

* LEO, LEE, LRO, LRE, LRD 

L IM I TS ( 24 ) 

( LIMITS, LHO) 

VM ( 300 ) 


DIMENSION 
EQUIVALENCE 
COMMON /C VM 


\ 






STREAMLINE TABLE 

COMMON /SLTAB / W ( 128 ) ,X2 ( 128 ), SLCHN < 128) 

INTEGER SLCHN 
BOUNDARY TABLE 
INDEX- LB=LBDO,LBDE 
LBNEXT = INCREMENT TO NEXT BOUNDARY 

LR7.1 = INCREMENT TO THE FIRST BOUNDARY POINT («0 BEFORE COALLATIO 

CHNAME = CHANNEL WITH WHICH THE BOUNDARY DATA IS ASSOCIATED 
UP = T OR F FUR UPPER OR LOWER BOUNDARY 

LEOEX = RELATIVE INDEX OF L.L. POINT WHEN LOWER AND UPPER SURFACE 
CONTOURS ARE CONNECTED 

BDNAME,LBA f LBB=NAME AND INDEX LIMITS OF SPECIFIC BOUNDARY 



ooooo oonooooonooooonoo 


C 


DATA WHEN BOUNDARIES ARE COALLATED 
DIMENSION BDT I 1) , LBNE XT ( I ) , LBZ1 ( 1 > , 

1 CHNAME ( l ) ,UP(1) ,L6DEX< 1) , 

2 2HT( II ,RBT( I ) ,ANGBT(A2) 

LOGICAL UP 

INTEGER BDT. CHNAME, BDNAME 

DIMENSION BDNAME (1 I ,LB A ( I ) , LBB ( 1 ) 

EQUIVALENCE ( BDNAME, ZBT) , ( LBA,KBT J , ( LBB, ANGBT) 

ELOW ADJUSTMENT TABLE 
INDEX- LI =LFU,LFL 
NFCfJL S = H 

Xlf = ORTHOGONAL COUROlNATt 

X2F = STKIAMLINE COORDINATE OF SL EMlNATING FROM T.E. 

X1BF = x 1-COORDINATE OF CHOKE STATION OF FLOW BELOW T.E. 

X 1 A h = X I -COOR D I N AT E OF CHOKE STATION OF FLOW ABOVE T.E. 

S I f = S 1- COORD I NAT l OF T.E. (UPPER SURFACE). THIS ITEM 
IS USED WHEN INTERPOLATING FOR WAKE DELTA-STAR. 
LFB,LFA=INDICES OF STATIONS BELOW AND ABOVE T.E. 

NCHB»NCHA=N UMBER OF CHANNELS BELOW ANO ABOVE T.E. 

LRF = INDEX OF DUMMY ORTCHN LIST FOR THE T.E. 

LRXF = INDEX OF LAST CHANNEL BELOW THE T.E. 

JORDE R = 0 IF TOTAL FLOW AT XiF IS GIVEN 
* 2 If FLOW ABOVE T.E. IS GIVEN 
- i i f flow below t.e. is given 

JORDE R = -1 IF FLOW AT XIF IS CHOKED AND SINGLE CHANNEL 
DIMENSION X1F( 1) , X2FI l ) .X1BFII) ,XIAF (1) , 

1 SIF( I) ,NCHBIl),NCHAII) ,JORDERIl) ,VNR(12> 

EQUIVALENCE < L FB , X IB F ) , ( LF A , X I AF ) , ( LRF ,NCHB) , I LRXF , NCHA ) 

DIMENSION LFB( 1) , L F A ( 1 ) , LRF ( 1 ) ,LRXF(1) 

STATION TABLE 
INDEX- L 3 LO,LESTA 

SCHOK E 3 STATION CHOKE INDICATOR ( ADJWF ,BRHS,WRIOUT ) 

MCL = SHARP CORNfcR INDICATOR (BLDTBS) 

MCL = FIELD INDEX OF CONTROL STREAMLINE ( PTMOVE .FLOBAL ) 

COMMON /CHDATA/ X I ( 1 ) , LNE XT ( l ) , MLB ( 1 ) , MUB ( l ) , PRI M 1 1 ) , 

1 T YPE LB ( 1 ) , NAMEL B ( 1 ) , I LB ( I ) ,FLB(1 ) , S1LB( I ) , 

1 T YPFUH ( l ) , NAMEUB ( I ) , IUB(l) ,FUB(I ) ,S1UB( 1 ) , 

3 VMB( I ) »DWDV( I ) , X 2 C L ( 1 ) ,VCL (1 ) *MCL( A8 1 ) 

LOGICAL PRIM 

D I Mfc NS I ON SCHOKE(l) 

EQUIVALENCE ( SCHOKE , D WDV ) 

EQUIVALENCE ( BDT, XIF , X I ) , ( LBNE XT , X2 F , LNE XT ) , ( LBZ I , XI BF , MLB ) 

FQUI VALENCE ( CHNAME , X 1 AF , MUB ) , ( UP , S1F , PR I M ) 

EQUIVALENCE ( L LDE X , NC HB, T YPE LB > , ( ZBT , NCHA , NAMELB ) 

EQUIVALENCE ( R B T , JORDE R, I LB ) , ( ANGBT , VNR , F LB ) 

COMMON /CTABPR/ I I TAB 

CALL TABPRT < 6HALL COM , MAC HA , 20 ,8 ) 

CALL TABPRT(3HCFB»L, 33, A) 

CALL TAHPRT(5HC IDEX.M, 5,S) 

I 1 TAB = L8D0 

CALL TABPRTl 6HBDYTAB ,BDT ,LBDE ,3 ) 

I1TAB = LFO 

CALL TABPRT(6HCADJWF ,X1F ,LFfc ,6) 

IITAB = LO 

CALL TABPRT(6HSTATAB,X1,LESTA,5) 




CALL LSPFIK AREA,FPY,NK, AREA, SPY, NK, -1 > 

00 630 K= 1 , NK 

ST X ( K ) = SVX ( K ) +SPX (K ) 

6 30 S T Y ( K ) = SVY(K )+SPY(K ) 

KA = 1 

00 640 LL=l,LU 
J r J 1 1 LL ♦ 1 )- 1 

K = K1ILLUI-1 

IF (MU. NT. 0) GO TO 6 3 5 
S T XU ( J)=STX(K)-STX(KA) 

STYU( J)=STY(K)-STY(KA) 

635 IF(MD.NE.O) GO TO 640 
STYD( J > =STY(K I-STY (KA ) 

ST XC( J ) =STXIK I-STX (KA ) 

640 KA * K 

IF ( PRPRN.EQ. (-1 )) GO TO 800 

WRITE (6,1700) SVX(NK) ,SVY(NK) , SPX (NK) ,SPY(NK) tSTX(NK) ,STY(NK ) 
LINES = LINES+4 

1700 FORMAT ( /6X2 5HSUM- VM*COS( PHI )*DFLOW *F10. 2 ,36X, 25HSUM-VM*S INI PHI ) 
**DFLOW =F10.2,/6X25HSUM-(P-PS0)*C0S(PHI)*DA =F 10.2 ♦ 36X, 25HSUM- I P 
*-PSO)*SIN(PHl )*0A =F 10.2, /6X25HT0T AXIAL MOMENTUM FLUX »F10.2,36X, 
♦25HT0TAL Y-MOMENTUM FLUX *F10.2,) 

C RELOCATE DATA INTO THt M-ARRAYS 

800 CALL MOVE ( 2 , M ACM , MACHM ( MA I , NK, 1 , PS , PSMI MA ) , NK, 1 ) 

CALL M0VE(2,PT,PTM(MA),NK,1, TT , T TM ( MA ) , NK , 1 > 

C FILL IN STAGNATION POINT VALUES 
IF(MLB(L).EQ.MA> GO TO 820 
M = MLBIL ) 

CALL GETIX 
MACHM ( M ) =0 . 

PTM ( M ) = PTM ( MU ) 

PSM(M)=PTM(M) 

TTM ( M ) = TTM( MU ) 

VMF CM )= 0. 

820 IF(MUB(L).EQ. MB ) GO TO 830 
M = MU8 ( L ) 

CALL GETIX 
MACHM ( M ) =0. 

PT M ( M ) =PTM ( MU ) 

PSM(M )=PTM(M) 

TTM(M ) = TTM( MU ) 

VMF(M)= 0. 

C INOEX TO NEXT STATION 
830 L = L +LNEXT ( L ) 

IF (L.LT.LESTA) GO TO 500 

RETURN 
END 

OVERLAY! STC, 3,0) 




DECK STCXX 

PROGRAM STCXX 

COMMON /CMAXIT/ M A X I T , MA JC TR # GREF I N , EOUM 
COMMON /SELECT/ LtNTRY 
1 GO TO (S. 10 , 15 , 20.1 M , LENTRY 

initial distance ALONG sl-s 
‘j CALL SLC 
GO TO 25 
REFINE GRID 
10 CALL REFINE 
GO TO 25 

SLCtPTMOVEtADJWF 
15 CALL SLC 
17 CALL PTMOVE 
CALL SPC 
CALL FARFLD 
GO TO 25 

ADJUST SL POSITION, CALC. FAR FIELD VELOCITIES 
20 CALL ADJSL 



IF I EL D = 0 
JSUM = 0 
LINES = 64 
LINEA = 0 
L = LO 

500 PL B = 0. 

PUB = 0. 

WF = 0. 

C SUBSON 1 C / SUPl k SONIC RKANCH SELECTION 
M = MLR(L) 

CALL GET IX 
JA = J 
MAA = M 
M = MUR ( L ) 

CALL GETIX 
JR = J 
MRB = M 

I F ( JSUM.EO.O) SUBSON* . TRUE . 

IF(SSEF) SUBSON* . FALSE. 

IF ( SCHOKE ( L ) .NE.XCHOKE ) GO TO 510 
IF(SSDF) SUBSON*. FALSE. 

J SUM = J A+256* JB 

C EXECUTE FLOW BALANCE 
510 CALL FLORAL 

I F C TYPELBIL I .EO.TE .OR. TYPEUBI L) . EQ. TE I JSUM*0 

C BRANCH AND ASTERP ARE PRINTUUT INDICATORS 

DATA DRSTAR/2H**/, SUH/3HSU6/, SUPER/5HSUPE R/ » I CH0KE/5HCH0KE/ 

501 ASTLRP= BLANK 

I F ( PR I M ( L ) ) ASTERP =OHSTAR 
RR ANC H = SUPER 
IF (SUBSON) BRANCH* SUB 

IF ( SCHOKE (L ) .EO.XCHOKE ) BRANCH* I CHOKE 

CALL SETM( 1, BLANK . CHANL S * 10 ) 

CALL MOVE ( 2,ZF ( MA ) , Z ,NK, 1 , RF ( MA) , R , NK , 1 ) 

CALL MOVE ( 2 » CURVF ( MA ) f CUR V» NK , 1 t VMF ( M A ) * VM, NK , 1 ) 

LO =0 

K = 1 

M = MA 

520 FLOW(K)=WSTA(K)*CG 

PHl(K)= PHI 1 (M)*TQOEG 
OGAM = FGR(K)/( I . +F GR ( K ) ) 

MACH( K ) = VM ( K ) *SOR T (OGAM/ ( RGI K )* TS ( K ) ) ) 

AOARE F ( K ) = R ( K ) 

IF ( AXIA ) AUARFMK) = Pl*K(K)*K(K) 

PS ( K ) = R HO ( K )*KG<K)*TS(K) 

PS OPO ( K )=PS(K )/PSA 
PSOPT(K)=PS(K)/PT(K) 

TSQTT (K)=TS(K)/TT (K) 

C CP MUST FOLLOW USE OF RG 

CP ( K ) = ( PS( K )-PSA ) *00 
CALL GETIX 
X I 2 ( K )= X2( J) 

IF(SLCHN(J).EO.CHANLS(LQ) ) GO TO 530 




10 = L0> 1 

J 1 ( L 0 ) = J 
K 1 ( LU ) = K 

CHANL S ( L0 ) = SLCHN ( J ) 

IF(LQ.GT.l) F LOWMX ( L 0- 1 ) =FLOW I K ) 

I * 0 

525 I = l+l 

IF(SLCHN(J).NE.ICHN( D.AND.I.LT.IC) GO TO 525 
OPTO = l./WPTOJ I ) 

530 PTQPTOIK )=PT(K >*QPTO 
K = K + l 

M = M + i 

IF(K.LE.NK) GO TO 520 
J 1 ( L(J ♦ 1 > = J ♦ 1 
K 1 ( L 0 + 1 )=K 

H. OWM X(lO) 3 fl. OW(K-l) 

LOS * 0 

543 LOS * L0S*1 

KB = K 1 ( LOS ) 

KE = KllLOS+ll-1 

FL MX * l./FLOWMX (LOS) 

DO 535 K=KB,KE 
535 PFLOW(K )=FLOW(K)*FLMX 
IF(LQS.LT.LQ) GO TO 533 

XII = X1(L) 

I F ( PRPRN • EQ • ( — 1 ) ) GO TO 610 
CALL FHEAD(LINEA+NK) 

LINEA = A 

I F ( .NOT.PRIM(L ) ) LINEA=8 

WRITE (6,1600) XI 1,ASTERP,CHANLS, BRANCH, 

1 ( X 1 2 ( K ),PFLOW(K) ,Z(K),R (K) ,PHI ( K ) ,CURV ( K ) , PSQPO (K) , PSOPT (K) , 

2 TSOTT(K) ,CP(K) , MACH ( K ) , AOAREF ( K) ,PTQPTO(K) , K c 1 , NK ) 

1600 FORMAT (/25H STATION COORDINATE, X 1 1 * ,F 7 . 3 , A2 , 13H CHANNELS- , 

1 10 ( A6,2X ),A5// 5X, 13HXI 2 STKM FNCT,6X,3HX»Z*8X,3HY,R,8X,3HPHI, 

16X,AHCURV,6X,21HPS/P0 PS/PT TS/TT,6X,2HCP»6X ,4HMACh,6X, 

3 6H AREA, 3X,6HPT/PT0 / ( 2X ,F 6. 3 ,F 10. 3 , F 1 2 . 5 , F 1 1 . 5 , F9 . 3 , F 1 1 . 5 , 
A F9.3»2F8.3,F10.3,F9.A,Fll.3,F9.3 f 7X,ltl 


610 IFC .N0T.PRIM1 L U GO TO 800 
M = MA 

DO 620 K = 1 , NK 
COSPH I = COS (PHI 1 ( M ) ) 

S I NPH I = S IN ( PHI 1 ( M ) ) 

F VX ( K ) = VM ( K ) ♦COSP H I 
FVY(K)=VM(K)*SINPHI 
FPX(K ) = (PS(K)-PSA)*COSPHI 
FPY ( K ) = (PS(K)-PSA)*SINPHI 
620 M = M+l 

SVX( 1 )= 0. 

SVY ( 1 )= 0. 

SPX( 11=0. 

SPY ( l )= 0. 

CALL LSPFIT( WSTA,FVX,NK, WSTA,SVX,NK, -l) 
CALL LSPFIT(WSTA,FVY,NK, WSTA,SVY,NK, -l) 
CALL LSPFIT(AREA,FPX,NK, AREA , S PX , NK , -1) 



oooooooooo 


♦DECK WRIOUT 

SUBROUTINE WRIOUT 

♦WRIOUT WRITE STC OUTPUT DATA -WRIOUT- 


COMMON /ALLCOM/ 


1 

2 


real 

LOGICAL 
LOGICAL 
COMMON /CFB 


1 

* 


NK « PLBC* PUBC • 
QV ( 8 ) , Q V P ( 8 ) , 


LOGICAL 
COMMON /CSS 


INTEGER 
LOGICAL 
SSFML * 
SSEF = 
SSEANG= 
SSDF = 
SSF ENU = 
SSFNDI= 
SSDLE = 
AAF ACT = 
BRL X = 
CURRLX= 
COMMON 


1 

2 

2 


C 

C 


* 

* 

* 

* 


NEW 

CAN 


EQUIVALENCE 


MACHA,PSA,TSA,PTA,TTA, AXI A.RGA.GAMA, 

MACHC »PSC,TSCfPTC,TTC, AXIC ,RGC,GAMC, 

DAXI T»SCALEAfTTE tCHOTST 
MACHA ( 1) .MACHC 
AXIA.AXIC 
C HOT ST 

L ♦ MA , MB, PLB , PUB » WF , CHOKE , SUBSON, 

XCHOKE , T ARE A , VMBC • WRQST.WCALC, 

J SUM , VMLBSQ 

CHOKE .SUBSON 

SSFML,SSEF,SSEANG, SSDF, SSF END, SSF ND1 
,SSDLE,A4FACT,BRLX,CURRLX 
SSFML 

SSEF, SSDF, SSDLE 

SUPERSONIC CURVATURE FORMULA NUMBER 
SUPERSONIC ENTERING FLOW, T OR F 
ENTERING FLOW ANGLE (DEGREES) FOR SSEF-T 
SUPERSONIC DISCHARGE FLOW, T OR F 

SUPERSONIC BEAM DOWNSTREAM END CONDITION, -0,1 FOR PARABOL 

SUPERSONIC BEAM UPSTREAM END CONDITION, «0,l, FOR PARABOLA 

SS FLOW BELOW AND AFT OF LE PT, T OR F 

CENTRAL POINT INFLUENCE COEFFICIENT FACTOR 

B-REL AXAT ION FACTOR 

CURVATURE RELAXATION FACTOR 

/ERASE 2/ AREA (96) .ARE AO (96) , 01 SP ( 96 ) , PT (96 ) , L AMBDA ( 96 ) • 

R HO ( 96), SQRTVV(96) ,TS(96) ,TT (96) ,VMSQ(96) , 

VVKQKP ( 96 ) , 

WQA(96),WSTA(96), RG ( 96) »C2CP(96 ) , FGR(96 ) 

LAMBDA 

JIUO) ,Ki(iO) .CHANLS(IO) , PS ( 96) , MACH(96 ) , FLOW ( 96 ) 
XI 2 (96) , Z(96) ,R ( 96 ) , PH I (96 ) »CURV < 96 ) , PSQPO( 96 ) , 
VM(96),FVX(96),FVY(96) ,FPX(96) ,F PY( 96 ) , SVX ( 96 ) , 
SVY( 96) , SPXI96) , SPY (96) , STX ( 96 ) , STY ( 96 ) 

( AREA0,XI2,FVX, STX) , ( D I SP , l , FVY , STY ) , 

( SQRTVV.R.FPX), ( VMSQ , PH I , F PY ) , ( VVKQKP, CURV, SVX ) , 
( WQA,PSOPO,SVY) , ( C2CP.VM, SPX ) , 

MACH 

X ( 1 » » Y( 1 ) 

(X,Z ) , ( Y * R ) 

NASA VERSION ONLY 


REAL 

COMMON /ERASE 3/ 
DIMENSION 


(FLOW, SPY) 


REAL 

0 I ME NS ION 
EQUIVALENCE 
VARIABLES FOR 


USE FGR IF 
DIMENSION 

EQUIVALENCE 


COMMON /IXORIG/ 


* 

♦ 

* 


DIMENSION 
EQUIVALENCE 
COMMON /CBEND / 
COMMON /CBITS / 


NEEDED 

PFLOW ( 96 ) .PSQPT (96) ,TSQTT(96) ,CP ( 96 ) , AQAREF (96 ) , 

P T QPTO ( 96 ) , F LOWMX ( 10 ) 

( FLOW, PFLOW) , ( LAMBDA, PSQPT) , (TS.TSQTT ) , 

( R HO , C P ) , (FGR, AQAREF) , ( RG , PTQPTO) 

LHO,LHE, LBDO.LBDE, LTO.LTE , LWO,LWE, LFO.LFE, 
LO,LE STA , LDUM(8), ^ 

MO ,NM , N J , NFCOL S , MAXNJ , MAXOL ,MAXNM, MAXLE , 

LEO, LEE, LRO.LRE , LRD 
LIMITS(2M 
( L IMITS,LHO) 

NBCB ( 2 ) , ANGE ( 2) .CURVE (2 ) ,FB(2 ) 

U I TS, BLANK 


\ 


V 



n r> r> n n 


COMMON /CCUBI / NBC! 2) ,C l ! 2 ) ,C2 < 2 ) , FEND ! 2 ) 

COMMON /CGRAV /CO 

COMMON /CPI / P I .TWOPI , P l 02 , P I 04 , T OOEG , T ORAD 
COMMON /CMEFIN/ SGI , SG2, VMGl , VMG2 

1. NOW, NO/, SGR! 10) .GKI10) , SG7 ( 10) ,GZ ( 1 0 ) 

COMMON /SLTAB / W ( 1?H I ,X2 I 12H) , SLCHNI 12B) 

INIIOEP SLCHN 
SI All (JN IABLE 
INDEX- L*LO,LESTA 

$C HOK fc = STATION CHOKE INDICATOR ( AD J WF , BRHS , WR IOUT ) 

MCI = SHARP CORNER INDICATOR (BLDTBS) 

MCL = FIELD INDEX OF CONTROL STREAMLINE ! PT MOVE , FLOBAL ) 

COMMON /CHDATA/ X 1! I > , LNE XT ! 1 ) , MLB < 1 ) , MUB ( l ) , PRI M < 1 ) , 

1 TYPE LB (1) .NAMELBU) • I LB ( 1 > ,FLB<1 ) ,S1LB( I) , 

1 TYPEUB! 1 ) , NAMEUB ( 1 ) ,IUB<1 ) ,FUR<L ) »S1UB( 1 ) , 

3 VMB ( I ) f 0 WOV ( l ) « X2CLI1 ) » VCL ( I ) »MCL ( 481 ) 

LOGICAL PRIM 

integer typelb, t ypeub 

DIMENSION SCHOKE(I) 

EQUIVALENCE ( SCHOKEfDRDVl 

COMMON /BCOMMN/ PKOGM ( 9 ) , F I L I N» F I L OT 
LOGICAL FILIN, FILOT 

COMMON /ADAMOI/ NAME (6)«ADDRES( 6) , T I TLE ( 6 ) , IDE NT (6) 

COMMON /CCURV / CURVE! 300) 

COMMON /CDS2 / MACHMI300) 

REAL MACHM 

COMMON /CPHI1 / PH 1 1 ( 300 ) 

COMMON /CPRINT/ PR TE S2 , PR TB , PRT A, PREF I N , PREFN2 , S SON I C , PDUM ( 1 0 ) 
COMMON /CPRPRN/ PRPRN 
INTEGER PRPRN 

COMMON /CB / PSMI300) 

COMMON /CS2 / PTM( 300) 

COMMON /CR / R F ( 300 ) 

COMMON /CRHS / TTM(300) 

COMMON /CVM / VMFI300) 

COMMON /CZ / ZFI300) 

COMMON /CIOEX / M , J,MU,MD» I STAG 
COMMON /CLINES/ L I NE S , OM I TFK , PT I TL E I 6 > 

COMMON /CFRFL 0/ fSAV(300 ), S TXU I 1 2 8 ) , STXD 1 1 28 ) , S T YU ( 1 28 ) , ST YD I 1 28 ) 
COMMON /CHNFP T / I CHN ( 1 0 ) , WTF S ( 1 0 ) , WTF A 1 1 0 ) , WPTOI i 0 ) , WTTO ( 10 ) , IC 

INTEGER DBSTAR , SUB, SUPER , BLANK .BRANCH, CHANLS, AS TERP.TE 
LOGICAL UPSTRM ,DNSTRM 

DATA TE/2HTE/ 


C 


PIINV * l./PI 
QO - 0. 

IF! MACHA.LE..I ) GO TO 95 

IF! GAMA .NE .0. ) GO TO 92 

QO = (RGA*TSA)/(P S A ♦MACH A* MACH A ) 

GO TO 95 


92 QO = 2 • / ( GAM A*PSA*MAC HA*MACHA ) 


BEGIN LOOP THROUGH STATIONS 
95 CHOKE = .FALSE. 




160 M = MD 

IF(H.GT.O) GO TO 124 
GO TO 180 

C APPROACH STREAMLINE 

170 XKEYB = ASL 

GO TO 2 00 
C BOOY SURFACE 
180 XKEYB =XK5SV 
GO TO 200 

C TRAILING STREAMLINE 

190 XKEYB = XK5SV 
XK5SV = TSL 

200 IFIXKfcYB .(U.TSl) (.(I II) 220 
IF < .NUT .LOW! R I GO 10 220 
LB = LBF I NAME LB (l ) ) 

IFILEUEX(LB).EO.O) GO TO 220 
C L UUP TO FIND BOUNDARY NAME OF UPPER SIDE OF L.E. 

LBX = LB 

214 IF(LBA(LBX).GE.LEDEX(LB) ) GO TO 220 
LBX = LBX+3 

IFILBX.LT. (LB + LBZHLBm GO TO 214 
CALL ERROR 1 
220 SPOAI 1)=SP0ASV 

CALL LSUMI AW,PSMPO,Nl , SPDA) 

SPD AS V = SPDA ( N I ) 

ARM = RM 

IF ( AXIA ) ARM = P I *RM#RM 
DO 225 1=1, NI 
AW ( I ) = ( AW I I l-ARM ) / ARM 

225 CDPI(I) = SPDA( I ) ♦OO/ARM 
ADOG = SPDASV + Ol l/ARM 
230 LINES = 64 

CALL F HI AO ( N I ♦ A ) 

KUP = 2 
I F ( LOWER ) K UP = l 
CHN = SLCHNIJ2) 

X I 2 = X2 ( J 2 ) 

SWORG = 0. 

WRITE (6, 1200) LOW UP (KUP ) »CHN»XI2, ( X 1 1 (I) , SW ( I) , Z W ( I ) , RW ( I ) , 

* ANGW ( I ) , CURVW( I ) , PSQPOI I ) »C P ( I > , PSQPT III ,MACH(l ) .CDPIU) ,AWt I ) , 

* PT QP TO ( I ), 1=1, NI ) 

1200 FORMAT (/2X,A6,17H BOUNDARY TO CHN=,A6,31H, STREAMLINE COORDINAT 
*E, XI2=,F7.3,1H.// 5X, 3HXI l ,6X , 3HS 1 W, 7X , 5HXW, Z W, 6X , 5HYW , RW* 5X , 

* 4HANGW,5X,5HCURVW»5X,5HPS/P0»5X,2HCP,4X»5HPS/PT »4X»4HMACH» 5X» 

* 4HCDP I , 14H ( A-AMAX) /AMAX,8H PT/PTO / ( 2 X ,2F8. 3 , F12 .5 , F 1 l .5 , 

* F8.3,F11.5,2F9.3,F7.3,2F9.4,F14.3fF8.3,I, I 

WRITE (6,1210) TIOTTO 
1210 FORMAT ( /6X , BHT T / T TO =,F9.3) 

IF ( XKEYB. EO. ASL ) WRITE (6,1220) ADDG 
1220 FORMAT ( /6X , I 5HA00 I T I VE DRAG *,F9.4) 

IF(MD.GT.O) GO TO 123 

C INTEGRAL MOMENTUM BALANCE ON THE CHANNEL 
I F ( .NOT • LOWER) GO TO 310 




II H = SPDASV 
GO ffl no 

110 HJH = SPOASV 

TTOl = STXUI J2 ) +H.B+FUB 
TERR = F rOT-STXD( J2 ) 

WRITE (6,1300) CHN,STXU( J 2 ) , F LB , FUB , F TOT , S T XD ( J2 ) ,FERR 
1300 fORMAT ( /1X32HINTE GftAL MOMENTUM BALANCE , CHN= A6, 2 X19H < AX I AL FORCES 

* ONLY ) /6X31HENTER ING MOMENTUM = F1 1 .4 , /6X31HLQWER BOUND 

* ARY PRESSURE FORCE = F 1 l . 4 , /6 X 31HUPPE R BOUNDARY PRESSURE FORCE =F11 

* .4 , / 1 2X 1 2HSUM OF ABO VE F2 4 . 4 , /6X 3 1HLE AV I NG MOMENTUM =F 

♦1 1.4, /12X25HLRROR =Fil.4 f ) 


J ? = J 2 ♦ 1 

IF ( J2.LE.NJ ) 
RE TURN 
\ NO 


CO 10 IDS 




COMMON /CFB / L , MA , MB , PLB , PUB , WF .CHOKE . SUBSON. NK, PLBC , PUBC, 

1 XCHOKEt TAREA,VMBC, WRQST.WCALC, QV ( 8 ) , QV P ( 8 ) » 

* jsum.vmlbso 

LOGICAL CHOKE. SUBSON 

C INDEX- M = MO » NM 

COMMON /Cl / Z1300) 

COMMON /CR / R ( 300 ) 

COMMON /CSX / S l ( 300 ) 

COMMON /CPHI1 / P H 1 1 ( 300 ) 

COMMON /CM / JMS1300) 

COMMON /CCURV / CURV(300) 

COMMON /CIDEX / M , J , MU . MD . I S T AG 
COMMON /CVM / VMI300) 

COMMON /CDS2 / M ACHM ( 300 ) 

REAL MACHM 

COMMON /CB / PSM( 300) 

COMMON /CS2 / PTMI300) 

COMMON /CRHS / TTM1300) 

COMMON / 1 XOK 1 0/ LHO.LHE, lbdo.lbde, lto.lte, lwo.lwe, lfo.lfe, 

* LO.LFSTA, LOOM ( 8 ) , 

* MO,NM, NJ, NX COLS, MA XN J , MAXOL , MAXNM , MAXLE , 

* LEO, LEE, LRO.LRE.LRD 

DIMENSION L I M I T S ( 2 A ) 

EQUIVALENCE (LIMITS, LHO) 

COMMON /CBEND / NBCB ( 2 ) , ANGE ( 2 ) .CURVE ( 2 ) ,FB ( 2 ) 

COMMON /CB I T S / BITS, BLANK 

COMMON /CCUBE / N BC ( 2 ) ,C 1 ( 2 ) , C2 ( 2 ) , FEND ( 2 ) 

COMMON /CGRAV / CG 

COMMON /CPI / PI »TWOPI , PIQ2,PIQ4,T0DEG,T0RAD 

COMMON /CREFIN/ SGI, SG2, VMG1 , VMG2 

1, NGR.NGZ, SGRt 10) ,GR( 10) , SGZ ( 10 ) . GZ ( 10 ) 

COMMON /SLTAB / W ( 12 8 ) , X 2 ( 1 28 ) , SLCHN ( 128 > 

INTEGER SLCHN 

COMMON /CHNFPT/ ICHN ( 10) , WTF S ( 1 0 ) ,WTFA( 10) ,WPTO( 10) ,WTTO( 10), IC 

INTEGER HLE , HTE , A SL , BOY , TSL ,CHNN ,ChN, XK5SV, XKEYB, BLANK 

LOGICAL DOUBLE , LOWER , UPPER 

DIMENSION L OWUP ( 2 ) 

DATA L0WUP/5HL0WER,5HUPPER/ 

DATA HL E , HTE/ 2HLE , 2H TE / , ASL , BD Y , T SL /3HASL , 3HBDY , 3HTSL/ 


C DEFINE REFERENCE DYNAMIC PRESSURE, ETC 

00 = 0 . 

I F ( M ACHA . L E . . 1 ) GO TO 95 

I F ( GAMA .NE.O. ) GO TO 92 

QO = (RGA*TSA)/(PSA*MACHA*MACHA) 

GO TO 95 

92 QO = 2./ (GAMA*PSA*MACHA*MACHA) 

C BEGIN LOOP THROUGH CHANNELS 

95 LINES = 64 
IUP = 4 
NCHN = l 
J2 = 1 

105 CHNN = SLCHN ( J 2 ) 

LOWLR = .TRUE. 




I « 0 

J f ) / I * I ♦ I 

If (MINN. NT . If.MNI I ) .AMI). I.lf.lU Of i ffj 107 
01' II) 1 1 . /Wf' UK I I 

01 10 * 1 ./Wl 10(1) 

00 10 122 
1 10 J2 = IP* 1 

iriJ2.E0.NJ .OK. S LC HN I J 2* 1 ) • N£ . CHNN ) GO TO 120 

GO CO 110 

120 LOWER = .FALSE. 

C BUILD I-SUBSCR IPTfcO ARRAYS 

122 M = MBEGINIJ2) 

L =0 

SPDAS V= 0. 

XK5SV = BOY 

123 I =1 

SWORG = SUM) 

PTO = PTMIM) 

TTO = TTM(M) 

TTQTTO= TTM(M)*OTTO 

124 DOUBLE 3 .FALSE. 

125 SWI I ) 3 S1IM) - SWORG 

ZW( I ) = l CM ) 

RWI I ) = RIM) 

ANGW ( I )=PHI1(M)*T ODE G 
CUR VW ( I )= CUR VIM) 

PS = PSM(M) 

PSOPT ( I )=PS/PTM(M) 

PTQPTOI I )=PTMIM)*QPTO 
MAC H ( I ) =MACHM ( M ) 

AW ( I ) 3 RWI I ) 

I F ( AXIA ) AWII)=PI*RW< I)*RW( I) 

PSOPOI I ) =P S/P S A 

PSMPOI I )=PS-PSA 

CPI I ) 3 PSMPOI I ) *Q0 

I F I LOWER ) PSMPOI I )=-PSMPO(I) 

CALL GET I X 

CALL STANOlM,LtUPPER ) 

X I 11 I ) = X 1 I L ) 

NI 3 I 

I 3 I ♦ 1 

IFINI.EO.1) GO TO 160 

C CHECK FOR LEADING EOGE POINT 

I F I ISTAG.NE.1 ) GO TO 140 

IF I TYPELBIL ) .EQ.HLE .OR. TYPEUBCD.EQ.HLE) GO TO 170 
C I S T AG 3 1 

IF I DOUBLE) GO TO 160 
DOUBLE 3 .TRUE. 

GO TO 125 

C CHECK FOR TRAILING EDGE POINT 

140 1F( ISTAG.NE .2) GO TO 160 
C I S TAG= 2 

IFITYPELBCL I.EQ.HTE .UR. TYPLUB (L ) .tQ.HTt ) GO TO 190 
C I ST AG=0» 3 OR DOUBLE = T 



♦DECK USECDW 

BLOCK DATA USECDW 

♦USECDW REPLACE STCW USE CARDS 

COMMON /ERASE 3/ WDUM (318) 

END 




ooooo oooooooooo 


-WRIBDY- 


♦ IjM.k WMHUY 

SUBROUT INI WR I Bf) Y 
♦WRlHDY WRITE OUTPUT 


F OH EACH BOUNDARY 


COMMON /BCCJMMN/ PROGM ( 9 ) , F I L I N, F 1 LOT 
LOGICAL FILIN, F1L0T 

COMMON / ADAMO 1/ NAME < 6 ) , ADORE S( 6 > , T I TLE ( 6) , IDENT ( 6 ) 

COMMON /CLINES/ L I NE S , OM I TFK , PT I TLE ( 6 ) 

COMMON / CNORM / RHL , RM, AHL , ARM 

COMMON /ERASE2/ X 1 1 { 100 ) , SW ( 1 00 ) , 2 W ( 1 00 ) , R W { 1 001 • ANGW ( 100 ) • 

* CURVW( 100 ) , VE (100) , MACH( 100) , PSQPOI 100 ) , CP ( 1 00 ) ♦ 

* PSQPT ( 100 ) ,PTOPTO ( 100) , TT ( 1 00 > , A W ( 100 ) , SPDA ( 100 ) 

NEW VARIABLES FOR NASA VERSION ONLY — PSQPT AND PTQPTO 

COMMON /ERASE V AO AN ( 1 00 ) ,CD P H 1 00 ) , PSMPO ( 1 00 ) 

MACH 

xw ( i ) , yw ( n 

( XW, ZW ) , I YW , K W ) 

FSAVl 300 ) , ST XU I 128) , ST XD ( 1 2 B ) ,S T YU ( 1 28 ) , ST YD ( 128) 


l< E AL 

DIM) NSIUN 
( QUlVALfcNCE 
COMMON /CFRFL 0/ 


COMMON /ALLCOM/ M ACHA , P S A , T S A , P T A , T T A , AXl A , RGA, GAMA , 

1 MACHC,PSC,TSC,PTC,TTC, AXl C ,RGC, GAMC , 

2 DAXI T, SCALEA, TTE,CHOTST 

MACHA { 1 ) , MACHC 
A X I A , AXl C 
CHOTST 


REAL 
LOGICAL 
LOGICAL 
BOUNDARY TABLE 
INDEX- LB=LBDO» LBDE 
LBNEXT= INCREMENT TO 
INCREMENT TO 
CHANNEL WITH 


POINT (=0 BEFORE COALLATIO 
DATA IS ASSOCIATED 


AND UPPER SURFACE 


NEXT BOUNDARY 

LBZ1 = INCREMENT TO THE FIRST BOUNDARY 
CHN AME= CHANNEL WITH WHICH THE BOUNDARY 
UP = T OR F FOR UPPER OR LOWER BOUNDARY 
LEDEX = RELATIVE INDEX OF L.E. POINT WHEN LOWER 
CONTOURS ARE CONNECTED 

BDNAME , LBA, LB8 C NAME AND INDEX LIMITS OF SPECIFIC BOUNDARY 

DA I A WHEN BOUNDARIES ARE COALLATED 
DIMENSION BDT ( l ) ,L BNE X I ( l ) , LBZ l ID » 

1 CHNAME ( l ) »UP ( 1 ) , LEDEX I l ) , 

2 ZBT< 1),RBT(1> ,ANGBTU2I 

LOGICAL UP 

INTEGER BUT, CHNAME, BDNAME 

DIMENSION BDNAME (1 ),LBA(1 ) , LBB ( l ) 

EQUIVALENCE ( BDNAME , 2BT ) , ( LBA ,RBT ) , ( LBB » ANGBT ) 

STATION TABLE 
INDEX- L=LO,LESTA 

SCHOKE= STATION CHOKE INDICATOR ( AD JWF , BRHS , WR IOUT ) 

MCL = SHARP CORNER INDICATOR IBLDTBS) 

MCL = FIELD INDEX OF CONTROL STREAMLINE ( PTMOVE , FLOBAL ) 

COMMON /CHDATA/ X 1 ( 1 ) , LNE XT ( 1 ) , MLB 1 1 ) , MUB ( 1 ) , PRI M 1 1 ) , 

1 TYPE LB ( l),NAMELB(l),ILB(l) , FL B 1 1 ) , S IL B ( l ) , 

1 TYPEUBI l ) ,NAMEUB ( 1 ) * IUB ( 1 ) , FUBl 1 ) , S1UB ( 1 ) , 

3 VMB ( l ) , D WDV ( l ) , X2CLU) « VCL (II ,MCL(48l ) 

PRIM 

TYPE LB, TYPE UB 

SCHOKE ( 1 ) 

( SCHOKE, OWDV) 

(XI, BDT) , (LNE XT »LBNEXT) , ( MLB,LBZ1 ) , (MUB, CHNAME) 
( PRIM, UP ),( TYPE LB, LEDEX) , (NAME LB, ZB T ) , ( ILB.RBT ) 
( FLB , ANGBT ) 


LOGICAL 
INTEGER 
DIMENSION 
EQUIVALENCE 
EQUIVALENCE 
EQUIVALENCE 
EQUIVALENCE 


\Df° 



LH = LHP 
GO TO 122 

124 I F ( PTO(LH).NE.BITS .AND. PTO ( LH ) . NE . 0. ) WPTOI 1C) =PTO ( LH) 

I F ( TTO(LH).NE.BITS .ANO. TTO ( LH ) .NE.O. ) WTTOU C 1 * TTO ( LH ) 

12b IF(J2.LT.NJ) GO TO 100 

130 WRITE (6,1130) ( ICHN(I),WTFS( 1) ,WTFA<I) ,WPTO( I),WTTOfn,I«l,lC) 
1130 FORMAT </49H CHANNEL FLOW RATfcS, PRESSURES. AND TEMPERATURES-// 

* 16X,9H SPECIFIED, 5X,8H AD JUSTED, 7X»6HPT/PS0»7X*6HTT/TS0 / 

* ( 6X, A6,4F13.4, ) , ) 

I F ( .NOT . F I LOT ) RETURN 
REWIND NT APN 

WRITE ( NT APN ) STCF IL , ( LI M ITS ( I I f 1 *1. 24) 

WRITE (NT APN) ( ( I DEN T ( I ) , 1 = 1,6) ,A X I , RG ,GAM , MACHO , PSO, TSO. PTO , TTO , 

1 PRPRN,TTE,CHOTST,MAXlT,MAJCTR, (NINNER(I) ,1=1,16), VELPOT.ICOB, 

2 NODENS,RN,NGR,NGZ, ( SGR ( I), 1=1,40), VMG1,VMG2, INRCTR, SLS,SG21, 

3 NBC IN ( 1 ),NBCIN(2),ACF( 1 ) ,ACF(2) . SSFML , SSEF , SS E ANG, SSDF , SSFEND, 

4 SSFN01 ,SSDLt,A4FACT,BRLX,CURRLX,TSIC, (FARFLD( I ) ,1-1,8), 

* RHUC , RHOC S S»RHL ,RM, 

5 (ZP( I ), 1 = 1,28), (TABLES(I),I = l,LESTA) , ( B ( I ) , I * l , NM ) , (JMS(I), 

6 1=1, NM), (Sl( I ), 1=1, NM ) , (S2(!)»I a l«NM),(2F(I),I*L,NM), (RF(I), 

7 1=1, NM)J (VMF( I ),I=i,NM), ( W ( I ) , I = l , N J ) , ( X2 ( I ) , I * l , N J ) , 

8 ( SL CHN ( I ) , 1=1 ,NJ), I0LRL,MAXSWP,T0LES2,T0LINR,SG1MIN,DS1DMP, 

A DS1RM0, (CRX( I ), 1=1,6), RHOBAS , RHOAMP , I ADM, NTHKX .NTHKY, 

B ( THKX( I ) , 1 = 1, 118) ) 

NTS AV = NTAPO 
NTAPO = NTAPN 
NT APN = NTSAV 
RETURN 
END 

OVERLAY! STC,2, 3) 




WRITE (6, 1005) SSFMLtSSFEND, SSFN01 , SSEANG, SSEF , SSDF, SSDLE 
1005 FORMAT ( 43H CURVATURE CALCULATION FOR SUPERSONIC FLOW-/ 

16X , 7HSSFML =,I8,19H (FORMULA NUMBER)/ 

26X,7HSSFEND=,F8.3,43H (DOWNSTREAM ENO CONDITION, SSFML*2 ONLY)/ 
36X, 7HSSFND1=,F8.3,41H (UPSTREAM ENO CONDITION, S$FML*2 ONLY)/ 
46X, 7HSSEANG=,F8.3,43H (INLET FLOW ANGLE, DEGREES, SSEF-T ONLY)/ 
5/38H SUBSONIC/SUPERSONIC BRANCH SELECTION-/ 

66X,7HSS(F r * L 8 » 3 7H (SUPERSONIC ENTERING FLOW, T OR F | / 

76X » 7HSS0F -,LH,‘>6H (SUPERSONIC FLOW DOWNSTREAM OF CHOKE STATION 
*♦ T OR F ) / 6X, 7HSSDLE =,L8,58H (SUPERSONIC FLOW BELOW AND 

BAFT OF A L.E. POINT, T OR F ) ) 

WRITE (6,1010) (GR( I ), 1=1, NGR) 

WRITt (6,1011) ( SGR ( l),I=l,NGR) 

IF(NGZ.EQ.O) GO TO 65 

WRITE (6,1012) (GZ(I),I 3 1,NGZ) 

WRITE (6,1013) (SGZ( I),I=1,NGZ) 

65 WRITE (6,1014) VMG 1 , VMG2 , CRX 

1010 FORMAT ( /1X19HGRID SIZE C R I TE R I A-/6X7HNGR/GR*10F8 .2 ) 

1011 FORMAT (6X.7HSGR =,10F8.2) 

1012 FORMAT (/6X,7HNGZ/GZ SS *10F8.2) 

1013 FORMAT( 6X,7HSGZ =,10F8.2) 

1014 FORMAT ( /6X , 7HVMG1 = ,F8. 2 ,25X,7HVMG2 *,F8.2//6X,7HCRX *,6F8.3 ) 

WRITE (6,1030) NM.MAXNM, LESTA.MAXLE, NJ,MAXNJ 
1030 FORMAT( /1X19HMEMURY UT I L I ZA T 1 0N-/24X 1 7HUSED A V A I LA BL E/ 6X l i HGR I D 

* POINT SI 11, I10,/6X6HTABLESI16,llO,/6XilHSTREAMLINESlll* 110, ) 

ATL DS2 = CLEN*T0LES2 

write (6, 1040) maxi t,nkef in, inrctr,tolinr,toles2,clen,atlds2,es2mx, 

1 DS 1 DMP ,NODFNS 

1040 FORMAT (/IBM CONVERGENCE DATA-/ 

1 6X , 7HM A X I T = , I 8 , 3X , 20H ( M AX I MUM ITERATIONS)/ 

26X, 7HNREF IN=, 18, 34H - NUMBER OF REFINEMENT ITERATIONS/ 6X,7HINRCTR 
3= , I B , 66H - NUMBER OF ADDITIONAL ITERATIONS AFTER LAST REFINEMENT// 
46X,7HT01INR=, EB.1,47H (INNER ITERATION TOLERANCE ON S*L. MOVEM 

4ENT ) / 6X, 7HTOLES2 = , E8. l,37H (FINAL TOLERANCE ON S.L. MOVEMENT) 

5/6X,7HCLEN =, F«.3,52H - CHARACTERISTIC LENGTH BASED ON GRID S1Z 

6E CRITERIA/ E21.1,38H - ABSOLUTE TOLERANCE ON S.L. MOVEMENT/ 

76X, 7HMAXES2=, E8.1,42H - LARGEST S.L. MOVEMENT ON LAST ITERATION/ 
8/ 6X , 7 HD SI DMP = , F8.3,54H (STREAMWISE PT MOVEMENT DAMPING, =0 FOR 

9 NO DAMPING)/ 6X , 7HN0UEN S = , I 8 , 5 8H (REFINEMENT LEVEL TO WHICH CON 
ASTANT DENSITY IS ASSUMED)) 

LINES = 64 
CALL FHEAD(13) 

WRITE (6,1090) FARFLD 

WRITE (6,1092) I ADM, RHOB A S , KHOAMP , TOLRL 
1090 FORMAT (/26H SPECIAL BOUNDARY OPTIONS-/ 6X , 7HF ARF LD» , 2 ( 2X , A6 ) I 
1092 FORMAT!/ 28H MATRIX SOLUTION PARAMETERS-/6X , 7HIADM * , 1 8 , 3X, 70H( *- 
11,0,1, FOR STREAMLINE, ALTERNATING, AND ORTHOGONAL LINE RELAXATION 
2)/ 6X, 7HRH0BAS=,F8. 3, 3X, 33H( ACCELERATION FACTOR, BASE LEVEL)/ 

36X, 7HRH0AMP=,F8. 3, 3X,45H( ACCELERATION FACTOR, AMPLITUDE OF VARIATI 
40N ) / 6X , 7HT0LRL =, E 8 . 1 , 3X , 30H ( TOLERANCE RELATIVE TO MAXDS2) ) 

C PRINT HIGHLIGHT AND MAX. BODY RADII AND AREAS 
AHL = RHL 

IF(AXIA) AHL = P I *RHL*RHL 




A I' M - KM 

If ( A X J A ) AKM=P I *KM*MM 

WKin I 6 , 1091 ) RMl , AHL ,RM,AKM 

lO'/l f ( ) K M A I I//6X, 1 7HHIGHL IGHT RADI US = ,F 8. 3 ,4X , I 5HHI GHL I GHT ARE A= * 

* FH. 1/6X, 17HMAX. HfJDV RAO I US 3 » F8.3»4X,15HMAX. BODY AREA=,F8.3) 

C PRINT CHANNEL TABLL (3F CONTENTS 

CALL f H F A D ( 2 » 

WRIIt (6,1060) 

LH = L HO 

80 IF ( LH.GE .LHE ) GO TO 96 
MOREL = A 

IF(NRILH).NE.O) MORE L = MOR EL* 2+NR ( LH ) 

CALL FHEAD( MOREL ) 

LH2 - LH + 9 

WRIlf (6, 1070) CHNAM(LH) , ( WTF LO W ( LHX) »LHX=LH»LH2 ) 

NCX = NC(LH) 

I F ( NK ( L H I .L f . 0 ) GO TO 95 
WRITE (6,1080) ( T A B < 1), 1=1, NCX) 

CALL ( ABPRT( 2HB=, BB( LH ) ,NCX*NR( LH ) ,NCX) 

95 LH = LH+LHNE XT ( LH ) 

GO TO 80 

96 CONTINUE 

1060 FORMAT ( /IX26HC0NTENTS OF CHANNEL TABLE-) 

1070 FORMAT ( //6X7HCHN =2X , A6 , 5X 7HWTF LOW® E 1 2 . <►, /6X 7HTT0 = F8.2,5X 

♦ 7HPT0 =F8.3,5X7HTS0 =F 8 . 2 , 5 X7HPS0 =F 8 . 3 , /6 X7HMACH0 = F8.<,,5X7 

*HA0 = E12.4, 1X7HVARY =L8,/6X7HRG = F8.2,5X7HGAM =F8.*,) 

1080 FORMAT ( /6X7HNB/TAB=2X»A6, lHt5X» A6 » IH , 5X , A6 ,1H,5X,A6,1H,5X,A6, 1H, ) 


C 


100 

105 


1 10 


115 


120 


122 


LOOP THROUGH CHANNELS TO PRINT FLOW RATES, PRESSURES, 
RHO I NF = PSA/(RGA*TSA ) 

VINF = SQRT(GAMA*RGA*TSA)*MACHA 
WTNORM= RHOINF*VINF<>PI 
J 2 =0 

IC =0 
J 2 = J2+1 

JCHN = SLCHN ( J2 ) 

I F ( JCHN .N E • SLCHN ( J 2+ 1 ) .OR. J2.EQ.NJ) GO TO 110 

J 2 = J2* 1 

GO TO 105 

IC = IC+l 

WTFA( IC )=W( J2 I/WTNORM 

I F ( RGA.NE.i. ) WTFA ( IC ) =W( J2 ) 

I C HN ( IC )=JCHN 
LT = L TO 

I F ( JCHN.EO.CH(LT) ) GO TO 120 
L TP = LT+LTNEXT ( LT ) 

IF(LTP.GE.LTE) GO TO 120 
LT = LTP 
GO TO 115 

LTP = LT+LPSI (LT ) + NPT( LT)-i 
WTFST IC)=XCH(LTP) / WTNORM 
I F ( RGA.NE.I. ) WTFS ( IC ) =XCH ( LTP ) 

WPTO( IC )=PTC 
W T T 0 ( IC ) = TTC 
l H » L HO 

IF ( JCHN.I Q.CHNAM(LH) ) GO 10 12<* 


LHP = L H + LHNEX I ( LH ) 

I F ( LHP . GE .LHE ) GO TO 128 



AND TEMP 
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♦DECK 
* WR I A 


WR1A 

SUBROUTINF WR 1 A 

WRITE THE KEY(5)=A STC DATA RECORD -WRIA- 


COMMON /ALLCOM/ 


I 


REAL 

LOGICAL 

LOGICAL 

REAL 

EQUIVALENCE 
COMMON /CSS 


1 


IN I EGER 
LOGICAL 
SSFML = 
SSEF = 
SSE ANG= 
SSDF = 
SSFEND= 
SS FND1 = 
SSDLE = 

aafact= 

BRL X = 
CURRL X = 
TSIC = 
COMMON 


MACH A »PSA f TSA*PTA»TTA* AX I A ,RGA, GAMA , 
MACHC,PSC,TSC,PTC, TTC, AX I C , RGC, GAMC » 
DAXIT»SCALEA»TTE,CHOTST 
MACHAI 1) , MACHC 
AX IA ,AXIC 
CHOTST 
MACHO 

(MACHO^MACHA) , ( PSO , P SA ) , ( T SO, TSA ) , 

( AXI ,AXIA) , (RG.RGAI ,( GAM, GAMA) 

SSFML, SSEF, SSEANG, SSDF *SSFEND»SSF NO 1 
, S SOLE ,A4 FACT , BRL X.CURRLX, TSIC, RHOC.RHOCSS 
SSFML 

SSL F , SSDF, SSDLE 

SUPERSONIC CURVATURE FORMULA NUMBER 
SUPERSONIC ENTERING FLOW, T OR F 
ENTERING FLOW ANGLE (DEGREES! FOR SSEF*T 
SUPERSONIC DISCHARGE FLOW, T OR F 

SUPERSONIC BEAM OOWNSTREAM END CONDITION, =0,1 FOR PARABOL 
SUPERSONIC BEAM UPSTREAM END CONDITION, =0,1, FOR PARABOLA 
SS FLOW BELOW AND AFT OF LE PT, T OR F 
CENTRAL POINT INFLUENCE COEFFICIENT FACTOR 
B-REL AXAT I ON FACTOR 


FOR TRANSONIC INTERPOLATION 
LTO.LTE, LWO , LWE , LFO.LFE, 


* 

* 

* 


CURVATURE RELAXATION FACTOR 
NUMBER OF POINTS TO BE READ 
/IXORIG/ LHO, LHE , LBDO.LBDE , 

LO,LESTA, LUUM (8 ) , 

MO.NM, NJ,NFCOLS, maxnj,maxol,maxnm,maxle, 
LEO, LEE, LRO,LRE,LRD 
L 1 M I T S ( 2 A ) 

(LIMITS, LHO) 

W( I2ti),X2(128), SLCHN ( 128 ) 


DIMENSION 
EQUIVALENCE 
COMMON /SLTAB / 
INTEGER SLCHN 


COMMON /BCOMMN/ 
LOGICAL 

COMMON /AOAMOI/ 
COMMON /BENDIN/ 
COMMON /CB / 
COMMON /CB I TS / 
COMMON /CCRX / 
DIMENSION 
EQUIVALENCE 
CHANNEL INPUT 
INDEX - LH=LHO 
COMMON /CHDATA/ 


PROGM ( 9 ) 
F ILIN, F 
NAME (6) , 
NBCIN12) 
B ( 300) 
BITS, IBL 
CR XSL »CR 
CRX( 6) 

( CRX ,CRX 
DATA TABL 
, L HE 

CHNATM I ) 


,f ILIN, FILOT 
I LOT 

ADORE S( 6) , TITLE (6) , IDENT (6) 

, AC F ( 2 ) 

ANK 

XOL,CRXSS,CRXE ,CRXC,CRMACH 

SO 

E 

, LHNLXT ( I ) , WTF LOW ( 10) , NR ( 1 ) , NC ( 1) » T AB ( 6 ) 


, 


1 BB t 75 ) 

DIMENSION TABLES(9y8) , T TO ( 1 ) , PTO ( 1 ) 

TABLE OF CONVECTED PROPERTIES 
INDEX- LT=LTO,LTE 
CH = CHANNf LNAMf 

LTNEXI= INDEX INCREMENT TO THE NEXT CHANNEL 
L PS I = RELATIVE LOCATION OF PSI LIST 
NPT = NO. OF PSI, TT, PT AND RCU VALUES 
DIMENSION CH( 1 ) ,LTNEXT ( 1) ,NPT( 1) ,LPSI (1 I ,LTT<495) 




INTEGER CH # C HN AM 
DIMENSION XCH( 1 ) 

EQUIVALENCE < C HNAM , TA BLE S . CH , XCH ) , ( LHNE X T , LTNE XT ) , 

* ( WTFLOI*»NPT ) , 

* (WTFLOWI2 ) ,LPSI,TTO), 

* ( WTELOWI 3 I ,LTT,PTO) 

COMMON / C I A 0 I N / K HOB A S ,R HOAMP , I ADM 

COMMON /CINNFR/ INRCTR,ROuM, NINNERU6) ,CNVF< 16) 

COMMON /CISBOT/ F AKF L 0 ( 2 ) , FRfc L ( 2 ) , PRE S ( 2 ) • RFF , N2 P • 

1 ZP(IO) (PPS(lO)t A 1 , A2 » ADUM ( 6 ) 

INTEGER FARFLO, FREE, PRES 

COMMON /CLINES/ L I NE S , OM FI F K , PT I TL fc I 6 ) 

LOGICAL OMTIFK 

COMMON /CM / J M S ( 300 ) 

COMMON /CMAXIT/ MA XI T , MA JC TR , GREF I N , EDOM 
LOGICAL GREFIN 

EQUIVALENCE ( MA JC TR, NREF I N) 

COMMON / CNORM / RHL , RM, AHL , ARM 

COMMON /CPI / P I ,TWGPI , P I Q2 , P I Q4 , TODEG , T ORAD 

COMMON /CPRINT/ P DUM I ( 3 ) , PRE F I N , PREF N2 , PDUM (1 1 ) 

COMMON /CPRPRN/ PRPRN 

INTEGER PRPRN 

COMMON /CPTMOV/ VE LPOT , I C OB , NODENS , C PTDUM 
LOGICAL VELPOT 

COMMON /CR / RF ( 300 ) 

COMMON /CREFIN/ SL S, SG21 ♦ VMG i ,VMG2 » NGR , NGZ , SGR ( 10 J , GR (10 ) , 

I SGZ ( 10 ) , G/ ( 10 ) 

COMMON /CSI / S 1(300) 

COMMON /CS2 / S 2 ( 300 ) 

COMMON /CTOLRL / TOLK L , MA X SWP , CL EN , 0S2MX , I OLE S2 ,N S WP , 

1 OblOMP,OSlMXA,DSlMXB,nSlRMS.FS2MX,DSIKMO, 

2 SG1MIN, TOLiNR 

COMMON /CTHICK/ NTHKX,NTMKV,THKX(20) ,THKY( 20) ,THIK2U( TB ) 

COMMON /CVM / VMF ( 300 ) 

COMMON /CZ / Zf ( 300) 

COMMON /CHNFP T / I CHN ( 1 0 ) , WTF S ( 1 0 ) , WTF A ( L 0 ) , WPTOI 10 ) , WTTO ( 10 ) , IC 
COMMON /TAPES / NTAPO,NT APN 

LOGICAL STCFIL 
DATA STCFIL/T/ 

DATA KA/1HA/ 


OMTIFK- .TRUE. 

IF(FILOT) OMT IFK= .FALSE. 

CALL FHEAD16A) 

TSC = TSA 

TTC = TSC*( I. ♦( GAMA-1. ) * . 5*MACH0*MACH0 ) 

PIC * PSC*( TTC/TSC )**(GAMA/(GAMA-l.) ) 

•jb WR I TE ( 6, 1000) AXI , MACHO, RG, TSC, GAM, PSC,TTL, PTC, CHOTST, TTC, 

1 NBC I N , ACF 

1000 FORMAT ( / 1 5H GENERAL INPUT-// 6X,7HAXI * , L 8 , 26 X , 7HMACH0 =,F8.A/ 
16X,7HRG =,F8.2,26X,7HTS0 =,F8.2/ 6X,7HGAM =,F8.A,26X, 

17HPS0 * , F 8 . 3/ 6 X , 7H T TE = , F8 . 3 , 26X , 7HPT0 =,F8.2/ 6X,7HCH0TST = 

1 , L8, 26X, 7HTT0 =,F8.3// 27H STREAMLINE END CONDITIONS-/ 6X,7HNBC 

UN =,218/ 6X, 7HACF =,2F8.3/ ) ; 

fib 
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♦ DECK ST ALGO 

SUBKflUT INF ST ALOO 

♦ STALOO LOOP THROUGH STATIONS AND EXECUTE flobal -staloo- 


COMMON /CFB 


I 

* 


LOGICAL 

COMMON /IXORIG/ 


nistruDV** ruoi, t 


LFO*LFE* 


* 

* 

* 


L , MA,MB*PLB»PUB*WF ,CHOKE , SUBSON, 

XCHOKE, T ARE A * VMBC • WRQST.WCALC, QV( 8 ) , QVP( 8 ) , 
J SUM »VMLB SO 

CHOKE, SUBSON 

LHO, LHE , LBDO»LBDE * LTO,LTE • LWO.LWE, 

LO, LESTA , LDUMI8), 

MO , NM , NJ.NFCOLS, MAXNJ,MAXOL » MAX NM , M AXLE » 

LEO, LEE, LRO,LRE,LRD 
L I MI TS ( 24 ) 

(LIMITS, LHO) 


DIMENSION 
EQUIVALENCE 
STATION TABLE 
INDEX- L=LO, LESTA 

SCHOK E = STATION CHOKE INDICATOR < ADJWF,BRHS,WRIOUT) 

MCL = SHARP CORNER INDICATOR (BLDTBS) 

MCL = FIELD INDEX OF CONTROL STREAMLINE ( PTMOVE , FLOBAL ) 

COMMON /CHDATA/ X 1 ( 1 ) , LNE XT ( 1) , ML B II ) , MUB II ) , PRI M (1) , 

I TYPELB ( 1 ) ,NAMELB(i) , I LB ID ,FLB(1 ) , S1LB( I ) , 

1 TYPEUBI I ) ,NAMEUB ( 1 ) , IUB( I) ,FUB(l ) ,SIUB( 1) , 

3 VMB(l) ,DWDV( 1), X2CL (1) , VCL ( 1 ) *MCL(481) 

LOGICAL PRIM 

INTEGER TYPELB, TYPEUB 


DIMENSION 
EQUIVALENCE 


SCHOKEd ) 

( SCHOKE, DWDV I 


COMMON /CB / 
COMMON /CFB2 / 
LOGICAL 

COMMON /C INNER/ 
COMMON /CPRINT/ 
COMMON /CRHS / 
COMMON /CTOLRL / 


B( 300) 

PASS1 

PASSI 

I NRC TR *RDUM ( 33) 

PRTES2,PRTB, PRT A , PREF IN, PREFN2 ,SSON IC »PDUM( 10) 
RHS( 300) 

TQLRL ( 10) ,ES2MX,DSIRM0,SGIREF,T0LINR 


C BEGIN LOOP THROUGH STATIONS 

CHOKE = .FALSE. 

JSUM = 0 
L = LO 

C CALL BRHS AND FLOBAL 

410 PL B = 0. 

PUB = 0. 

WF = 0. 

CALL BRHS 


C INDEX TO THE NEXT STATION (I.E. ORTHOGONAL) 
450 L * L+LNEXT ( L ) 

IF(L.LT. LESTA) GO TO 410 

PASSI = .FALSE. 

RETURN 

END 

OVERLAY(STC,2,2 ) 




♦DICK c rcwi 

PROGRAM SfCWl 

C WRIIK I HI OVIR-AII ',rc DATA KfcCORO, K£V(5I*A. 
CAM WR I A 
Rf I URN 
I Nl) 




OO OOOOOOOOOOOO 


♦DECK NEWRAP 

SUBROUTINf NF WRAP ( X,E ,V) 

♦NEWRAP OUTSIDE ITERATION PROCEDURE -NEWRAP 

C TO HE USED WHEN INNER SELF CONVERGENT RELATIONS EXIST. 


INPUT- 

X - ABSCISSA 

E - ERROR IN ThE ORDINATE 

V - STORAGE FOR A 12 ELEMENT VECTOR 

INPUT, FIRST ENTRY ONLY 
V( I) = CTR =0. 

V ( 2 ) = DEDX = ESTIMATE OF THE SLOPE OF THE CURVE 

( X2=X1-EI/DEDX IS THE FORMULA FOR THE SECOND X) 

( E/DEDX ) IS USED TO REDUCE DXMAX DURING THE ITERATION 
V ( 3 ) = XMOVE 

AHS(XMOVE) = MAXIMUM DELTA X 

S I GN I X MOVE ) = DIRECTION TO THE BRANCH OF THE CURVE WITH SLOPE*SI 


GUTPUT- 

X = NF X T X ESTIMATE 

COMMON /CNEWR / OE DXP ( 2 1 , DXP ( 2 ) ,DX » WS 

DIMENSION VII2). 0(121. XP(2)»EP(2) 

EQUIVALENCE ICTR.QII)), <DEDX,Q(2))» ( XMOVE , Q ( 3 I > . 

1 ( DXMAX *Q ( 5 1), ( D X PRE V , Q ( 6 ) ) t I OPS IGN , Q< 7 ) ) • (SPAN,Q(B) 

2 1 , (xp,Q( 9 n f (EP.omn 

logical span 

DO 53 I = 1,12 
50 C( I) * VII) 

IF I CTR.GE .30. ) CALL ERROR I 
I F I CTR.NE.O. ) GO TO 200 


C FIRST ENTRY 

OX = -L'/Dl l) X 
DXMAX = AHS ( XMOVE > 

DXPREV= DXMAX 
OPS I GN = 0. 

SPAN = .FALSE. 

GO TO 520 

C SECOND AND SUCCESSIVE ENTRIES, EVALUATE DEDXPt II AND DXP(l) 
200 WS = 0. 

DO 250 1=1,2 
DX P ( I ) = 0. 

I F ( I.EQ.l) GO TO 220 
IFCCTR.LE.l.) GO TO 270 
IF( WS.EQ.O. ) GO TO 220 

I F ( . NOT. SPAN .OR. (E*EP(2).GT.0.)I GO TO 
C I F C . NOT. SPAN .OR. SAME S IGN C E ,EP ( 2 III 

220 DE = E-EP ( I ) 

DX = X-XPI 1 ) 

IF( ABS(DE).LT.AHS( DX I/1.E15) GO TO 250 
IE< ABS(DX).LT.ABS(DE I/I.E15) GO TO 250 
DLDXP ( I ) = DE/DX 

C CHECK SIGN OF DEDXP ( I ) 


250 

DO NOT USE POINT 2 




If ( f Jl UXI'C I >*Df DX.t 1.0. ) GO 111250 
f ) X f» ( I ) = AMAX1(-UXMAX,AMIN1(-L/DEDXP< 1) , DXMAX) ) 

W S = W S ♦ 1 . 

/ L >(j CONI I DUE 

/to IKwS.Nf.O.) GO TO <,00 

C rut Uf. DX P HAVE INCORRECT SIGNS 

C TAKE MAX JUMP TOWARD THE CORRtCT BRANCH 

C MAY BL DESIRED ORO I N ATE IS ABOVL/BELOW THE MAX/MIN OF THE CURVE 
3 SO IF(OPSIGN) 360 » 36U , 3 55 
355 DXMAX = .5*DXMAX 
360 OPSIGN= -I. 

DX = XMOVE 
GO TO 520 

C MUHJCf MAX DX IF DIRECTION OF ITERATION IS CHANGING 
<,00 IMUPSlGN) <.10, <i90,V>0 
<.10 DXMAX = . 5*DXMA X 
<.90 OPS I GN = I. 

C PEDICT NEXT ABSCISSA, DEOXP HAVE THE CORRECT SIGNS 
500 DX =IDXP( 1>*DXP(2))/WS 

DXMAX = AMINKDXMAX.ABSI XMOVt I) 

C -DXMAX. LE.DX.LE. DXMAX 

520 DX = AMAX1 (-DXMAX .AMIN I ( OX « DXMAX I ) 

C SAVE CERTAIN GOODIES TO USE FOR FUTURE ENTRIES 

600 DXMAX = . 25*DXMAX ♦ . 75* AMI N l ID XMAX , AMAXl ( DXPREV , ABS I 2 . *E/ DE DX ) ) ) 
DXPREV= ABS(DX) 

XP ( 2 ) = XP( 1) 

EPI 2) = E P ( 1) 

XP( 1) = X 
EPI I) = E 

IFIEPl I)* EPI2I.LT. 0. ) SPAN=.TRUE. 

CTR = CTRM. 

C SET X AND RETURN 
X = X+DX 

DO 960 1=1,12 
960 VII) =0(1) 

RETURN 

END 
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M = M+l 

„ CALL GET I X 

1STAG = 3 
CALL SAV1X 
RHS(M)= 0. 

B ( M ) BRUMMY 
GO TO 756 

- C SPECIAL BOUNDARY I YPE S 

725 IF( TYPfcLB(L I.NE.FARFLD .AND. TYPE L B ( L ). NE . F REE .AND. 

* TYPELFMU.NE.PRES) GO TO 756 

_ B(M) = .5*( ARE AO ( 2)-AREA0( 1 ) )*BETSQP*(S2(2)-S2( 1 ) ) 

RHS(M)= AREA! 2)-AREA0(2) - AREA ( l ) +AREAOT 1 ) 

IF ( VMLBSO.NE.O. ) RHS ( M ) = RHS ( M ) 

1 -(ARE AO (2 )-AREAO( 1 ) ) *BE TS QP* . 5 * < VMlBSQ/ ( VMt M ) *VM( M ) )-l. ) 

' GO TO 756 

C INTERIOR POINT 

- 725 BM = 0. 

If(MM.NF.M) GO TO 726 
T S A VG M = .5*( T S(KM ) ♦TS(KM1 )) 

_ GGAMM = FGK (KM) / t 1 .»FGR( KM) ) 

HE T SOM = l.-VM(MM)*VM( MM 1 ) *0G AMM /(RG( KM)*TSAVGM) 

KHOVM = ,5*(W0A(KMI)tW0A(KM) ) 

HM = ,5*BETS0M*(S2( MM I — S2 ( MM l ) ) /RHOVM 

726 IF(WSTA(K+1).E0.WSTA(K)) GO TO 728 
TSAVGP= ,5*(TS(K)+TSIK+1 ) ) 

OGAMP = FGR ( K ) / ( I . +F GR ( K ) ) 

- BE T SQP = I.-VM(M)*VM(M+1)*QGAMP/(RG(K)*TSAVGP) 

RHOVP = .5*(WQA(K-H)*WQA(K) ) 

RM = .5*BETSQP*(S2(M+1)-S2(M))/RH0VP ♦ BM 
_ 728 IF(SLSWKL).NE.O.) GO TO 730 

B ( M ) = BM 

GO TO 732 

730 R ( M ) = BRLX*RM+( l.-BRLX )*B(M> 

- 732 IF (MM.EG.M .AND. B (M )*B( M-l ) ,LT .0. ) SSOL=.TRUE. 

IF(WSTA(K+L).EQ.WSTA(K)) GO TO 757 

7 35 R H S ( M ) = ( AREA( K+I )-AR£AO( K + I )-AREA (K) ♦AREAO(K) ) / ( WS TA ( K+ 1 ) -WST A ( K ) ) 
_ 1 -( AREA(KM)-AREA0(KM)-AKEA(KMI)+AREA0(KMI )) /(WSTA(KM)-WSTA(KM 

2 D) 

756 KM 1 = K 

MM 1 = M 

- KM = K M 1 + 1 

MM = MM1+1 

GO TO 760 

C DOUBLE POINT (I.E. W(K+1)=W(K>) 

757 RHS ( M ) = ES2(K )-ES2(K + l ) 

760 K = K ♦ 1 

M = M ♦ 1 

IF(K.LT.NK) GO TO 725 

UPPER BOUNDARY 

NOTE- MB=MUB(L)-1 FOR A STAGNATION POINT 
M = MUB(L) 

RHS ( M ) = 0. 

M = MR 




RHS(M)= 0. 

QGAMM = FGR(K )/( 1 .♦FGRIK ) > 

Hf I SOM= 1 . - VM ( M )*VM( M)*QGAMM/ (RG(K )*TS( K) ) 
li(M) = BFTSOM* t S21MJ-S2 ( M- 1 ) )/WOA(K) 

IF ( B( M ) .fcO.O. ) B ( M ) =BDUMM Y 

SPFCIAL BOUNDARY TYPES 
TEST FOR SHOCK ON ORTHOGONAL 
CALL GET IX 

1 F ( MU.EQ.O .AND. MO.EQ.O ) GO TO 800 
IFl TYPEUBI L ) .NE .PRES .AND. 

1 TYPEUBIU.NE.FKEE .AND. 

2 TYPEUB(L).NE.FARFLD) GO TO BOO 

HIM) = .*>♦( A«FA()(K)-ARt AOIK-l) ) *BE T SQM* ( S 2 I M ) -S 2 ( M- 1) ) 
RHS I M ) = ARLAIK- n-ARLA()( K-II - ARE A ( K ) ♦ ARE A0( K ) 

BOO I F ||l) t M )*H I M- 1 >>. I T.O.) S SOL -.TRUE. 

....END CALC OF H AND RHS 

SLSWI ( L )=0. 

IF(SSOL) SLSWI (L > = 1. 

RETURN 

END 



IF(SCHOKE(L).NE.XCHOKE) GO TO 500 
IF(SSOF) SUBSON*. FALSE . 

J SUM = JA+256* JB 

C EXECUTE FLOW BALANCE 
500 CALL FLOBAL 

IF ( TYPELB(L ) .EQ.TE .OR. TYPEUBl D.EQ.TE) JSUM-0 
I F ( MA.FQ.MB ) RETURN 
VMB(L )= VMBC 

C EVALUATE S2-DE V I A T 1 ON S 
F = 1. 

1F( (TYPbLB(L).EO. SOLID .AND. TYPEUBl L) .EO. SOL ID) .OR. 

* TYPELRtL ) .EO. FIELD .OR. T YPEUB ( L ) . E C. F I ELD ) F» AREAO INK) /ARE A( NK ) 
IF( SSON IC.E0.2. ) F = 1 . 

C (PLANE 2-D) 

DO 510 K = 1 » NK 

510 E S 2 ( K ) = (F*AREA(K)-AREAO(K) )/ LAMBDA ( K ) 

I F ( .NOT . AX I A ) GO TO 550 
C ( AX I SYMMETR I C ) 

K =2 

M = MA+1 

520 E S 2 ( K ) = ES2(K)/(TW0PI*R(M)) 

K = K + i 

M = M+l 

IF(K-NK) 520,520,550 


C EVALUAIE MAXIMUM FLOW BALANCE ERROR, ES2MX 
550 IF(L.fcQ.LO) IS2MX=0. 

DO 560 K = l , NK 

560 ES2MX = AMAX1(ES2MX,ABS(ES2(K)) ) 

IF (PKTFS2 .LI. 2.) GO TO 600 

IF (Xl(L) .LT.PUUM(8).0R.XHL).GT.PRTES2) GO TO 722 
LMX 1 = L 

LMX2 = L 

NK X 1 = NK 

CALL MOVE ( 1,ES2,ES2X1,NK,1 ) 

IF (X1(L).EQ.PDUM(8) ) WR I TE ( 6 , 1 661 ) 

GO TO 660 

600 IF (PRTES2.NE.2.) GO TO 722 
DATA ENTRY2/F/ 

ES2MX0=0. 

00 605 K= 1 , NK 

605 ES2MX0= AMAX 1 ( fc S2MX0 , ABS ( LS2 ( K ) ) ) 

IF ( tNTRY2 ) (.0 TO 610 
E S 2 MX 1 = ES2MX0 
ES2MX2= ES2MX0 
L MX 1 = L 
L MX 2 = L 
NK X 1 = NK 

NK. X2 - NK 

CALL MOVE (2,ES2*tS2Xl,NK,i, E S 2 , E S2 X2 ♦ NK , 1 ) 

ENTRY 2 = .TRUE. 

GO TO 690 

610 IF( ES2MX0.LE.ES2MX1) GO TO 630 
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ES2MX2 = ES2MX1 
LMX2 = LMX1 
NKX2 = NKX1 

CALL MOVE ( l,ES2Xl,ES2X2,NKXl,l ) 

E S 2MX 1 = ES2MXO 
L MX 1 = L 
NKX1 = NK 

CALL MOVE ( l,ES2,ES2Xl,NK,l> 

GO TO 6 50 

630 IF ( ES2MX0.LE .ES2MX2) GO TO 650 
ES2MX 2= ES2MX0 
LMX2 = L 
NK X 2 = NK 

CALL MOVE( 1.ES2, ES2X2.NK, 1) 

650 I F ( MBB.NE .NM ) GO TO 690 
WRITE (6,1661) 

660 WR I T E ( 6 , 1 660 ) Xl(LMXl) 

M = MLBILMXl )-l 
IF(LMXl.EO.L) M =M A- 1 
00 670 K = 1 » NKX1 
M = M+i 

6 70 WRITE ( 6, 1 6 70 ) B ( M ) ,RHS(M) ,DS2(M) ,2 (M) , R ( M ) , PH 1 1 (M ) ,CL)RV( M) , ES2X I ( K ) 
IF( LMXl.E0.LMX2) GO TO 690 
L MX 1 = LMX 2 
NK X 1 = NK X 2 

CALL MOVE ( 1,ES2X2,ES2X1,NKX2,1 ) 

GO TO 660 
1661 FORMAT ( 1 H 1 ) 

1660 FORMAT (//9H ST A T 1 0N= , F8 . 3// 5X, 1HB , 1 OX, 3HRHS , 9X, 3HDS2 , 9X , lHZ , 10X , 

1 1HR. 10X,4HPHI1*7X,4HCURV,7X,5HES2X1/) 

1670 FORMAT ( 1 X , F 1 1 . 5 , 2 ( 3X , F9 . 6 ) , 4 ( F 1 1 . 5 ),3X,F9.6) 

690 CONTINUE 

C****CALC COEFICIENT B AND RHS OF MATRIX EQUATION FOR DS2 

C SET SUPERSONIC OL INDICATOR 
722 SSOL = .FALSE. 

LOWER BOUNDARY 

NOTE- M A=ML B ( L ) ♦ 1 FOR A STAGNATION P/INT 
M = MLB(L) 

RHS (M )= 0. 

K = 1 

M = MA 

RHS ( M ) = 0. 

QGAMP = FGR{ l)/( 1 • + FGR ( 1 ) ) 

BETSOP = l.-VM(M)*VM(M)*QGAMP/(RG(l)*TS(l) ) 

R(M) = BETS0P*(S2(M+1 J-S21M) )/WQA(l) 

C IS FIRST POINT AN ISTAG=3 PT AND THE FIRST OF A DOUBLE 

IF (WSTA(2).NE.WSTA( 1) ) GO TO 724 
IF(TYPELB(L).NE. FIELD) CALL ERR0R1 
C TREAT FIRST PT AS DUMMY PT AND 2ND PT AS ISTAG=3 PT 

RH S ( M ) = ES2 ( 1 ) - ES 2 ( 2 ) 

B ( M ) = BDUMMY 

CALL GETIX 
IS TAG = 0 
CALL SAVIX 
K = K + l 
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♦DECK BRHS 

SUBROUTINE BRHS 

♦ BRHS— COEFFICIENT B AND RHS TERMS -BRHS 


OUTPUT- 

RHS(M)= RIGHT HAND SIDE OF 
HIM) = COEFFICIENT OF THE 


THE MATRIX EQUATION FOR 
CURVATURE TERM 


OS2 


COMMON /ALLCOM/ 


1 

2 


REAL 
LOGICAL 
COMMON /CFB 


LOGICAL 
COMMON /CSS 


1 


INTEGER 
LOGICAL 
SSFML = 
SSEF = 
SSEANG= 
SSDF = 
SSFENO= 
SSFND1 = 
SSDLE = 

A AF AC T = 
BRLX = 
CURRL X = 
COMMON 


1 

2 
2 


REAL 

01 ML NS ION 
EQUIVALENCE 
DIMENS ION 
EQUIVALENCE 


MACHA,PSA,TSA,PTA, TTA, AX I A . RGA, GAMA * 

MACHC.PSC ,TSC,PTC,TTC, AXIC »RGC»GAMC» 
DAXlT,SCALEA,TTE,CHOTST 
MACHA ( I) , MACHC 
AXIAfAXIC tCHQTS T 

L ,MA ,MB, PLB,PUB,WF ,CHOKE , SUBSON, NK , PL BC , PUBC , 

XC HOKE » TaREA.VMBC, WRQST,WCALC, QV ( 8 ) t QVP ( 8 ) » 

J SUM * VML B SO 

CHOKE * SUBSON 

S SFML, SSL- FtSSEANG, SSDF, SSFEND.SSFNDi 
, S SDL t ,AA FACT ,BRLX,CURRLX 
SSFML 

SSEF, SSDF, SSDLE 

SUPERSONIC CURVATURE FORMULA NUMBER 
SUPERSONIC ENTERING FLOW, T OR F 
ENTERING FLOW ANGLE (DEGREES) FOR SSEF*T 
SUPERSONIC DISCHARGE FLOW, T OR F 

SUPERSONIC BEAM DOWNSTREAM END CONDITION, *0,1 FOR PARABOL 

SUPERSONIC BEAM UPSTREAM END CONDITION, *0,1, FOR PARABOLA 

SS FLOW BELOW AND AFT OF LE PT, T OR F 

CENTRAL POINT INFLUENCE COEFFICIENT FACTOR 

B-REL AXAT ION FACTOR 

CURVATURE RELAXATION FACTOR 

/ERASE 2/ AREA (96) , ARE AO I 96 ) ,D I SP I 96 ) , PT (96 ) , L AMBDA C 96 ) , 

KHO( 96 ) , SORT VV ( 96 ) , TS I 96 ) , TT ( 96) ,VMSQ(96) , 

V VKQKP ( 96 ) , 

WQA ( 96 ) , W ST A ( 96 ) , RG196) , C2CP ( 96 ) , FGR ( 96 ) 

L AMHDA 

ES2< 96), SONURM ( 96 ) 

(LS2.V VKQKP) , ( SDNQRM ,RHO) 

RCU( 96) 

(RCU, LAMBDA) 


INDEX- 

M=MO,NM 


COMMON 

/cz 

/ 

Z( 300) 

COMMON 

/CR 

/ 

R ( 300) 

COMMON 

/CS2 

/ 

S2 ( 300 ) 

COMMON 

/CS1 

/ 

S 1 1 300 ) 

COMMON 

/CPHU 

/ 

PHI I ( 300 ) 

COMMON 

/CM 

/ 

JM S ( 300) 

COMMON 

/CCURV 

/ 

CURV< 300 ) 

COMMON 

/CB 

/ 

B( 300) 

COMMON 

/CIDEX 

/ 

M,J, MU, MO, 1ST AG 

COMMON 

/IXORIG/ 

LHO.LHE, LBDO,LBDE , 


* 

* 

* 


0 I MENS lUN 
EQUIVALENCE 


LTO,LTE, LWO,LWE, LFO,L FE, 

LO,LESTA, LUUM(B), 

MO » NM , N J ,NF COL S , MA XN J , MAXOL , MA XNM , MAXLE , 

LEO, LEE, (RfJ,LRL,LRD 
L I M I T S ( 2 A ) 

(LIMITS, LHO) 


& 


COMMON /CBENf) / NBCB ( 2 > , ANGE ( 2 ) , CURVE ( 2 ) ,F B ( 2 ) 



o o o n o 


COMMON /CHITS / HITS, BLANK 

COMMON /CCOID / NBC ( 2 ) . C 1(2) ?C2 ( 2) ?FEND( 2 ) 

f.f IMM1 1 r j /(.CHAV / CC 

COMMON /CHI / HI ,IWOPl , P I 02 *P 1 04 ♦ T OHEG ? TORAD 
COMMON /CKfcl IN/ SC 1 ? , VMG1 * VMG2 

I. NGR.NG/, SGR ( 101 ,GR( 101 ? SGZ ( 10) , GZ ( 1 0 ) 

COMMON /SLTAH / w ( 1? 8 ) , X 2 ( 12« J , SLCHN ( 128 ) 

INHSfck SLCHfvl 
STATION TABLE 
INDEX- L=LO»L£STA 

SCHOKE= STATION CHOKE INDICATOR ( AD J WF , BRHS ?WR IOUT 1 
MCL = SHARP CORNER INDICATOR (BLDTBSI 

MCL = FIELD INDEX OF CONTROL STREAMLINE I PT MOV E , FLOBAL ) 

COMMON /CHDATA/ X 1 (II , LNE XT ( i ) , MLB ( 1 ) • MUB III , PRI M (1) « 

1 TYPELI3I 1 ) » NAMELB I 1 ),ILB(1),FLR(1),S1LB(1), 

1 T YPEUB ( 1 ) tNAMEUB ( 1 ) , IUB (1 ) ,FUB(1 ) , SlUB(l) , 

3 VMBI 1 ) ?DWDV( i ) * X2CL(i),VCL(l)*MCL(481> 

LOGICAL PRIM 

INTEGER TYPLLB , TYPEUB 
DIMENSION SCHOKE(l) 

EQUIVALENCE ( SCHOKE , DWOV 1 

DIMENSION SLSWI(l) 

EQUIVALENCE (SLSWI,VCL) 

C SLSWl = SONIC LINL/SHUCK WAVE INDICATOR 

COMMON /CDS2 / US2(300) 

COMMON /CM AX I T / M A X I T , MA JCTR , GREF I N , EDUM 
LOGICAL GREFIN 

COMMON /CPRINT/ PR TE S2 , PR TB , PRT A, PRE F l N , PREFN2 , S SONI C , PDUM < 1 0 ) 
COMMON /CRHS / RHSI300) 

COMMON /C TOLRL / T OLR L , MA XS WP , CL EN , DS2MX , T0LDS2 , N S WP , 

1 0SlDMP f ()SlMXA,DSlMXB,DSlRMS»ES2MX 

COMMON /CTABPR/ I 1 TAB 
COMMON /CVM / VMI300) 

INTEGER FARFLD, F I ELD ,F REE ? PRE S ? SOL I D , TE 

DIMENSION ES2X1(96),ES2X2(96) 

LOGICAL ENTRY2, SSOL 

C SSOL = SUPERSONIC POINT ON THIS OLt T OR F 

DATA FARFLD/6HFARFLD/, F I ELD/ SHF I E LD /, FREE/4HFREE/ ? 

* PRES/4 HP RES/? SOL ID /5HSQL ID/? TE/2HTE/ 

C INITIALIZE 

TOL S2 = AMAXK .01,2.*TTE ) 

HDOMMY= 1./1024. 

c subsonic/supersonic branch selection 

M = ML B I L ) 

CALL GETIX 
JA = J 

MAA = M 

M = MUB(L) 

CALL GETIX 
JB = J 

MBB = M 

IF( JSUM.EQ.O) SUB SON = . TR UE 
IF(SSEF) SUBSON=. FALSE. 




GO TO 255 


C FLOW IS NOT CHOKED 

24 5 L = LX2 

PL B = PL BX 
PUB = PUBX 
CALL FLOBAL 
250 V M B ( L ) = VMBC 

NLF = (LFE-U-LFOJ/NFCOLS 
ILF = (LF-LFO l/NFCOLS 

IF( 1NRCTR.E0.0 .OK. M00( 1NRCFK-1, NLF >.NE. ILF) GO TO 290 

IF(VNR(LF ) .NE.O. ) GO TO 252 

VNR(LF+l)=-2. 

VNRCLF+2 )=.25*WRQST 
252 WNEW = WRQST 
VNR ( L F +6 ) =0 . 

CALL NEWRAP<WNEW,WCALC-WRQST,VNR(LF) ) 

IF ( VNR(LF*6 I . EO . < - 1 . 1 ) WNEW=WCALC 
RATIO = WNEW/WROST 

C ADJUST FLOW IN THE STREAMLINE TABLE 
255 M = MLBIL ) 

CALL GETIX 
JA = J 

M = MUB ( L ) 

CALL GETIX 
JB = J 

C CHECK TO SEE IF USER WISHES FLOW RATE TO BE VARIED 

JX = JA 

258 LH = LHO 

260 IF( LH.GE.LHE) GO TO 267 

I F ( CHN AM (LH).EQ.SLCHN(JX) ) GO TO 265 
LH = LH + LHNE XT ( LH ) 

GO TO 260 

265 IF( .NOT.VARY(LH) ) GO TO 2 80 
267 IF(JX.EO.JB) GO TO 270 
JX = JB 

GO TO 258 

C ADJUST FLOWS 

270 DO 275 J=JA,JB 
275 W( J) = W( JJ'frRATIO 
GO TO 2^0 

C DO NOT ADJUST FLOWS, PRINT COMMENT IF SUPER-CHOKED 

280 IF( SCH0KE(LK2).NE .XCHOKE ) GO TO 290 
IF( RAF IO.LT.l. ) GO TO 282 
SCHOKE (LK2 )=0. 

GO TO 290 

282 WRITE (6,1280) R A T 10 , X 1 ( L K2 1 , CHNAM ( LH ) 

C SI-COORDINATE ON UPPER SURFACE AT THE T.E. 

290 I F ( JORDER(LF) .LT.Q ) GO TO 295 
M = MLB(LXA) 

S1F(LF)=SI(M) 

C INDEX TO THE NEXT T.E. FLOW ADJUSTMENT Xl-STATIONS 
295 LF = LF+NFCOL S 

GO TO 101 



L All M IJW A/J.J IJ '» IMtN I '> COMPLETED, 

0 RIltjRU HIP fLUw HALANCL AT ALL STATIONS. 

100 II f I'UIJM ( f, ) .£0 .0. ) KIT URN 
UTAH - Lf-0 

CALL r AHPKT ( 6HCADJWF ,X1F , LFE , 10) 

CALL TABPRT ( 1HW,W,NJ,10> 

Rf TURN 

1 2 HO FORMA T { /65H *** THE CHOKED FLOW RATE IS LESS THAN THE USER INPUT 
♦FLOw/RATE. ,6X,8HRATlO = ,F 9 . 6, 3X , 6HST A = , F 8 . 3 t 3X , 6HCHN = ,A6> 
END 



IF(X1BF(LF).NE.X1TE) CALL STAX1 (X1BFILF),X2TE,-1. «LKB,DUM) 
I F ( X1AF(LF ) .EQ.XlTEI GO TO 120 

lib CALL STAXUXLAF(LF»,-l.,X2T6,OUM f LKA) 

120 IF( JORDER(LF) ) 130,140,200 


C SINGLE CHANNEL CHOKE 
130 CHOKE = .TRUE. 

L = LKA 

CALL FLOBAL 

SCHOKE{L)=XCHOKE 

LK2 = L 

VMB(L )= VMBC 

RATIO = WCALC/WRQST 

GO TO 255 


C** ITERATE FOR T.E. 

140 I F ( .NUT.CHOTST) 
L = LKB 

CHOKE = .TRUE. 
CALL FLOBAL 
PUBX = PUHC 
WBC HOK = WCALC 
L = LKA 

CALL FLOBAL 
PL Bx = PL BC 
W AC HOK= WCALC 
CHOKE = .FALSE. 


PRESSURE, JOROERI LF) =0 
GO TO 150 


150 QVP = 0. 

PSTE = -1. 

155 L = LXB 

PL B = 0. 

PUB = PSTE 
CALL FLOBAL 
VMBSA V= VMBC 
WBO = WRQST 
WB = WCALC 

L = L X A 

IF ( CVP.EC.O. ) PSTE =PUBC 
PI B = PSTE 
PUB = 0. 

CALL FLORAE 
YO = WBO+WROST 
WAB = WB+WCALC 

I F ( CHOTST ) WAB=AMIN1 ( WBC HOK , WB H-AM J Ni ( WACHOK, WCALC I 
YTOL = i.E-5*Y0 
OYDX = -l.E-5 


CALL Q I REM (PSTE, WAB, .5*1 PT(1 I-PSTE I ,QVP) 
IF( CVP.NE.O. ) GO TO 155 
VMB (LXB )=VMBSAV 
VMB1LXA )=VMBC 

C SETUP TO ADJUST FLOWS 

I F ( NCHB (LF).NF.l) GO TO 170 
C NCHHILF l.EO. 1 



I = l X H 

^ A T III = WH/WBU 
l.l I II) 255 

C NCHAILf ) .EQ. 1 

1 10 RAT IU = WCALC/WRUST 
01) TO 255 

C** CALCULATION OF TE PRESSURE (GIVEN FLOW) AT STATION LX1 
200 I F ( JOROERdF I.E0.2) GU TO 205 
C J ORDE R = 1 

L X 1 = LXB 

L X 2 = LXA 

LK1 = LKB 

LK 2 = LKA 

GO TO 210 
C J0RDER=2 

205 L X 1 = LXA 

L X 2 = LXB 

LK 1 = LKA 

LK 2 = LKB 

210 L = L X 1 

CALL FLOBAL 
VMB(L)= VMBC 

IF( JOROER(LF) .E0.2) GO TO 220 
PL BX = PUBC 
PUBX = 0. 

GO TO 230 
220 PL BX = 0. 

PUBX = PL BC 

C CALCULATION OF FLOW (GIVEN TE PRESSURE) AT STATION LX2 
230 I F ( .NOT.CHOTST) GO TO 245 
C CALCULATE MAXIMUM/CHOKED FLOW 

L = LK2 

CHOKE = .TRUE. 

CALL FLOBAL 
CHOKE * .FALSE. 

VMBSAV= VMBC 
RATIO = WCALC/WROST 

C CALCULATE PRESSURE AT THE T.E. STATION 
235 IF ( LK2.E0.LX2 ) GO TO 24 0 
L = LX2 

WF = WCALC 

IF(SSI)F) SUBSON = .FALSE. 

CALL FLOBAL 
WF =0. 

SUB SON= .TRUL. 

NAMELIST /NLADJ/ L F , L XI , LKl f L X2 , LK2 , PLBX , PLBC ♦ PUBX* PUBC 
240 I F ( PDUM ( 6 ) . EU • 2 ■ ) WR I TE ( 6 *NLADJ ) 

I F ( (PLBX.NE.O. .AND. PLBC .GE . PL BX ) .OR. 

1 (PUBX.NE.O. .AND. PUBC .GE . PUBX ) ) GO TO 24 2 
GO TO 245 

C CHOKED FLOW 

242 SCH0KE(LK2)=XCH0K( 

VMB (LK2 ) =VMBSAV 
VMB(L)= VMBC 
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♦DECK ADJWF 

SUBROUTINE ADJWF 

♦ADJWF- ADJUST WEIGHT FLOW 


-ADJWF- 


COMMON /ALLCOM/ 


Hi A1 
LUG I CAL 

common /cfh 


I 

♦ 


NK,PLBC,PUBC 
QV ( 8 ) * QVP ( 8 ) 


1 


LOGICAL 

COMMON /CSS / 
INTEGER 

logical 

COMMON /E RASE 2/ 


1 

2 
2 


REAL 

DIMENSION 
EOUI VALFNCF 
DIMFNS ION 
EQUI VALFNCF 


MAChA,PSA,TSA,PTA,TTA, AX I A , RGA, GAMA , 
MACHC,PSC # TSC,PTC,TTC, AxIC,RGC»GAMC* 

DAX I T , $C ALE A , TTE .CHOTST 
MACmAI 1 ) v MAC ML 
AX IA ,AXI C tCHl) IS I 

L,Ma ,Mf <t PLBf PUB , WF , CHOKE , SUBSON, 

XCHOKE , T ARE A f VMBC » WRQST.WCALC, 

J SUM , VML BSQ 

CHOKE, SUBSON 

SSFML, SSEF, SStANG, SSDF , SSFEND , SSFND l 
, SSDLE,A4FACT,BRLX,CURRLX,TSIC 
SSFML 

SSE F , SSDF, SSDLE 

AREA (96) , ARE AO C 96) ,DISP<96) , PT 196 ), LAMBDA ( 96 ) 
KHO( 96 ), SQRTVVt 96 ) , T S < 96 ) , TT ( 96) ,VMSQ(96) » 

VVKQKP ( 96 ) , 

WO A (96), WSTA(96) , RG ( 96) ,C2CP (96 ) ,FGR(96 ) 
LAMBDA 

F S 2 ( 96) , SONQRMI 96) 

U S2, VVKQKP) , (SDNQRM,RHO) 

KCU( 96) 

I RCU, LAMBDA) 


INDEX- 

M=MU,NM 


COMMON 

/Cl 

/ 

l ( 300) 

COMMUN 

/CR 

/ 

R ( 300) 

COMMON 

/CS2 

/ 

S2( 300) 

COMMON 

/CS1 

/ 

SI (300) 

COMMON 

/ CPH I 1 

/ 

PHII ( 300 ) 

COMMON 

/CM 

/ 

JM S ( 300) 

COMMON 

/CCURV 

/ 

CURV (300 ) 

COMMON 

/CB 

/ 

B( 300) 

COMMON 

/ C I DEX 

/ 

M, J,Mu,MD, ISTAG 

COMMON 

/IXORIG/ 

L HO, LHE , LBDO ,L 


* 

* 

* 


DIMENSION 
EQUIVALENCE 
COMMON / SL T AB / 
INTtGER SLCHN 
COMMON /CHDATA/ 


E, LTO , LTE , LWO , LWE , LFO*LFE 

LO,LESTA, L D UM ( 8 ) , 

MO.NM, NJ.NFCOLS, MAXNJ,MAXOL,MAXNM,MAXLE, 
LEO, LEE, LRO , LRE , LRD 
L I M I TS(2A ) 

( L IMITS.LHO) 

W ( 128) , X 2 ( 128), SL CNN (128) 


CHNAM< 1) , LHNL XT ( 1 ) , WTFLOWd ) , TTO ( i ) , PTO( l ) , 
♦ TSU< 1) ,PSU( 1 ) ,MACHO( l),AO(l),VARY(5),TAB(6) 

integer chnam 

logical vary 

FLOW ADJUSTMENT TABLE 
INDEX- LF=LFO,LFE 
NFCOL S= 8 

X 1 F = ORTHOGONAL COORDINATE 

X2F = STREAMLINE COORDINATE OF SL EMINATING FROM T.E. 

X1BF = X 1-COORDINATE OF CHOKE STATION OF FLOW BELOW T.E, 
X1AF = X 1-COORD I NATE OF CHOKE STATION OF FLOW ABOVE T.E. 

Si F = SI-COORDINATE OF T.E. (UPPER SURFACE). THIS ITEM 
IS USED WHEN INTERPOLATING FOR WAKE DELTA-STAR. 


\k 



oooon oooo 


(. I I h ,1 I A - I NO! U 0» STATIONS Bl LOW AND ABOVE T.E. 

f. fJf.Mh, NCHA=NIJMUI « f J f CHANNILS BELOW AND ABOVE T.E. 

C ll'l = INDEX Of DUMMY UK ICON LI SI E OR THE T.E. 

(. IMXE = INDEX Of LAST CHANNEL BELOW THE T.E. 

JOKDL K = 0 If TOTAL ELOW AT Xlf IS GIVEN 
= 2 IE I LOW ABUVE T.E. IS GIVEN 
= 1 IF FLOW MFLIJW I.E. IS GIVEN 
JORDER= -1 IF FLOW AT Xlf IS CHOKED AND SINGLE CHANNEL 
DIMENSION X IE ( II ,X2F (li ,X1BF (I) ,XIAF II) , 

1 S 1 E ( II ,NCHB(1 ),NCHA< 1) , JORDERI I) ,VNR( 12) 

EQUIVALENCE ( L FB , X IB F ) , I Lf A , X 1 AF ) , I LRF » NCHB ) , I LRXF » NCHA ) 
DIMENSION LFB(l) ,LFA( 1 ) ,LRF ( 1) ,LRXF( 1 ) 

STATION TABLE 
INDEX- L =LO » L ES T A 

SCHUK E= STATION CHOKE INDICATOR l ADJWF ,BRHS , WRIOUT ) 

MCL = SHARP CORNER INDICATOR ( BLDTBS ) 

MCL = FIELD INDEX OF CONTROL STREAMLINE < PT MOVE ,FLOBAL ) 

DIMENSION X 1 ( I ) , LNE XT! 1 I , MLB (I > ,MUB( 1 ) « PRI M ( 1 ) , 

1 TYPE LB ( 1 ) tNAMELB (1),IL8(1),FLB(1),SILB(1), 

1 TYPEUBd ) .NAMEUBI I ) , I UB ( I ) , FUB II) ♦ S 1UB (i) , 

3 VMB( 1) tDWDVm, X2CL (1) »VCL (1) ,MCL( A81 ) 

LOGICAL PRIM 

INTEGER TYPELB , TYPE UB 
DIMENSION SCHOKE(l) 

EQUIVALENCE ( SCHGKE « D WDV ) 

EQUIVALENCE < CHNAM , X IF , X L ) , I LHNEXT, X2F , LNE XT) 

EQUIVALENCE I WT F LO W , X l B F , MLB ) , ( TTO, XI AF , MUB ) , ( PT 0 , S 1 F , PR I M ) 

EQUIVALENCE I TSO, NCHB, TYPELB) , ( PSO, NCHA , NAMEL B ) 

EQUIVALENCE ( MACHO , JORDER . I LB ) , I AO, VNR , F LB ) , ( VARY ( l ) , S ILB ) 
EQUIVALENCE ( VAR Y I 2 ) , T YPEUB ) , < VARY < 3 ) , NAMEUB ) , I VARY («►> , IUB) 

EQUIVALENCE ( VAR Y { 5 ) , F UB ) 

EQUIVALENCE I T AB I 1 ) , AREATB , S IUB ) , ( TAB I 2 ) , VMB ) , ( TAB ( 3 ) , DWDV ) 

EQUIVALENCE ( T AB I 4 } » X 2CL ) , I TAB ( 5 ) , VCL ) , (TAB(6),MCL> 

COMMON /CINNER/ INRCTR »RDUM, N INNER (16) tCNVF 1 1 6 ) 

COMMON /CPRINT/ C DUM ( 6 ) , PDUM ( 10 ) 

COMMON /CQIREM/ Y TOL , YO, DYDX ,CTRMA X 
COMMON /C TABPR / I1TAB 

C BEGIN LOOP THROUGH FLOW ADJUSTMENT TABLE 
LF = LFO 

101 IF ( LF .GE.LFE 1 GO TO 300 
PL B = 0. 

PUB = 0. 

WF = 0. 

CHOKE = .FALSE. 

SUBSON= .TRUE. 

X1TE = XIF(LF) 

X2TE = X2FILF) 

L X A = 1 

JF( JORDERILF ) . LT .0 ) GO TO 118 

C SEARCH FOR THE TWO STATIONS AT XIF(LF) 

CALL STAX II XITE,X2TE,X2TE,LXB,LXA) 

C SI ARCH FOR CHOKE STATION IF THE FLOW IS CHOKED UPSTREAM 
LKB = LXB 
LKA = LXA 




I P ( siftf ,U .0. ) GO TO 190 
N = (LWNLXnLW)-2)/2 

LSTAK = L VKN 

CALL LSPFIT(S1W(LW>,0ST(LSTAR),N. SI FTE f DI SP( K-l J » 1 » 0) 
IF(DISP(K-m 185,184,186 
184 DISP(K-H=-l. 

GO ro 190 
186 WAKfc = . TRUE . 

C LOOP FOR NEXT CHANNLL 
190 WADD = WSTAtK-1) 

GO TO 105 

C USf CONSTAN! 01 N S I I Y APPROXIMATION FOR MA JC TR . LE . NODENS 
200 IT (MAJCTK.Lt .NOOtNS) CALL Sfc T M< L , 0. , FGRX , K- l t 
Wf TU«N 
END 

0V/ERLAY(STC,2,1) 




ooooooooooooo 


X2F = STREAMLINE COORDINATE OF SL EMINATING FROM T.E. 

X1BF = X 1-COORDINATE OF CHOKE STATION OF FLOW BELOW T.E, 

X1AF = XI-COOROINATE OF CHOKE STATION OF FLOW ABOVE T.E. 

S 1 F = SI-COORDINATE OF T.E. (UPPER SURFACE). THIS ITEM 
IS USEO WHEN INTERPOLATING FOR WAKE DELTA-STAR. 
LFB»LFA=INDICES OF STATIONS BELOW AND ABOVE T.E. 

NCHB,NCHA=NUMBER OF CHANNELS BELOW AND ABOVE T.E. 

LRF = INDEX OF DUMMY ORTCHN LIST FOR THE T.E. 

LRXF = INDtX OF LAST CHANNEL BELOW THE T.E. 

JORDF R = 0 IF TOTAL FLOW AT X1F IS GIVEN 
=2 IF FLOW ABOVE T.E. IS GIVEN 
= 1 IF FLOW BF LOW T.E. IS GIVEN 
J OR UE R = -1 IF FLOW A I XIF IS CHOKED AND SINGLE CHANNEL 
DIMENSION X If ( 1 ) ,X2F( 1 ) ,XIRF (l ) ,XIAF ( L ) , 

1 SIM I ) ,NCHB ( 1 ) » NCHA ( 1 ) » J ORDER 1 1) * VNR ( 12 ) 

EQUIVALENCE ( L FB , XIBF ) , ( LFA , XI AF ) , (LRF,NCHB) , (LRXF, NCHA) 
DIMENSION Lf B( 1 ) ,LFA( 1 ) ,LRF ( I) ,LRXF(1) 

EQUIVALENCE ( CH, XLF , X2W ) * ( LTNE X T , X2F , L WNEXT ) , ( NPT, X1BF.SIW) 
EQUIVALENCE (LPSI,X1AF), (LTT *SIF ) , (LPT.NCHB), (LRCU,NCHA) 
EQUIVALENCE I CRG , JORDER ) , (CPGJ,VNR) 


COMMON /SLTAB / 
INTEGER SLCHN 
COMMON /IXORIG/ 

* 

* 

* 

DIMENSION 

EQUIVALENCE 


W( 128) ,X2( 128), SLCHN (128) 

LHO, LHE, LBDO.LBDE, LTO,LTE , LWO.LWE, LFO,LFE, 
LO.LESTA, LDUM { 8 ) , 

MO.NM, NJ.NFCOLS, MAXNJ , MAXOL , MAXNM, MAXLE , 

LEO, LEE, LRO,LRE,LRD 
L I MI TS12A) 

(LIMITS, LHO ) 


COMMON /CIUFX / 
COMMON /CMAXIT/ 
COMMON /CPTMOV/ 
COMMON /CR / 
COMMON /CSl / 
COMMON /CTHICK/ 
COMMON /C 7 / 
COMMON /ERASE / 


M, J,MU,MD,ISIAG 
MAXI T » MA JCTR »GREF I N, EDUM 
VE LPOT , I COB , NODENS ,C PTDUM 
R ( TOO ) 

SI (300) 

N THK X , NTHKY , THKX( 20) ,THKY(20) ,THIK2D(78) 

l ( 300) 

PS I ( 800) 


INTEGER CHX 


C INTERPOLATE FOR LAMINA THICKNESS 

NK = MB-MA+l 
CALL SE TM ( 1,1., LAM, NK ) 
IF(NTHKX.LE.l ) GO TO 100 
CALL LFIT2D(Z(MA) , R ( MA ) , L AM, NK ) 

C INITIALIZE 

100 WAKE = .FALSE. 



C DEFINE 
K 
M 

WADD 
105 NK 
Ki 
Ml 

110 CALL 


NUMBER OF 
= 1 
= MA 
= 0 . 

= 0 
= K 
= M 
GETIX 


STREAMLINI S, 


NK, 


ASSOCIATED WITH EACH CHANNEL 



o o 


II I M.UI: .Ml ) GO IIJ 114 
U IX - SLCHN(J) 

f * 5 I 1 * X 2 ( J > 

114 If ( SL CHN( J ) .NE.CHX ) G(J TO 120 
NK = NK+1 

D I SP ( K ) =0 • 

WSTAIK I =W C J l + WADO 
PSI INK )=X2( J) 

K = K + l 

M = M + l 

ifim.le.mb) go to no 


C FIND INDEX IN CONVTB 
120 LT = L TO 
1 2*> IF ( L T ,GT .L TE ) CAl I ERROR 1 

If (GUILT ) .EO.CHX ) Of) 10 1 30 
LT * L T ♦! TNE X T (LT 1 
GO TO 125 

INTERPOLATE FOR CONVECTED PROPERTIES 
SCALE THE PSI TABLE TO CONFORM TO THE LPSI -TABLE IN /CONVTB/ 
130 N I = NPT(LT) 

I = LT+LPSIILT) 

12 = I ♦N I 

IFIK1.EC.1 .AND. NK.EQ.l) PSIl=PSIl-8. 

PSU = 8.*AINT(PSIl/8.) 

F = XCH(I2-l>/8. 

DO 140 KN=1,NK 
140 PSI(KNI=(PSI(KNI-PSI1I*F 


IT 

= LT+LTT ( LT ) 



IP 

= LT+LPTILT) 



IS 

= lturcuil F ) 



CALL 

LSPFIT (CH( 1 ) ,CH( IT) , N I , 

PS I , T T ( Kl ) , NK , 

0) 

CALL 

LSPF IT (CH( I ) ,CH( IP) , Nl , 

PSI »PT( Kl ) »NK» 

0) 

CALL 

LSPF IT (CHI I ) ,CH( I S) ,NI , 

PSItRCU(Kl) ,NK 

t 0) 

CALL 

SET M ( l , CRG ( L T ),RGX(K1), 

NK) 


CALL 

SETM( 1,C2CP( LT) ,C2CPX(K1 ),NK) 


CALL 

SETM(1,FGR(LT),FGRX(K1) 

, NK ) 



C 

C 


C 


C 

C 


WAKE DISPLACEMENT THICKNESS 
SEARCH FOR X2-SUBT ABLE 
IF(M.GT.MB) GO TO 200 
X2J = X 2 ( J ) 

DISP(K-l)=-l. 

LW = LWO 

155 If(LW.GE.LWE) GO TO 190 

II ( X2W1LW) .E0.X2J ) GO TO 170 
LW = LW+LWNEXT (LW) 

GO TO 155 

FIND TRAILING EDGt SI IN THE FLOW ADJUSTMENT TABLE, 
1 70 LF = LFO 

175 IF( X2FILF J.E0.X2J ) GO TO 180 
LF = L F + NFCOL S 

IF(LF.LT.LFE) GO TO 175 
CALL ERROR 1 

INTERPOLATE FOR WAKE DISPLACEMENT THICKNESS, OSTAR 
180 S1FTE=S1 (M)-SIF(LF ) 

S 1 -F ROM- T . E • 



S IF 



160 TO ( M ) = F*T2(M) ♦( 1 .-F )*T1 <M) 


M = M*i 

IF(M.LE.NXY) go TO 100 

... END LOOP FOR INTERPOLATING TO(M> AT X ( M) , Y (M ) , H* 1 « NXY 

RETURN 

END 
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♦ dec k rrpr 


IJB 

POUT I 

NE 

TTPT 

(MA, 

MB, W 





TT 

, PT 

t 

AND RCU 

L 

n 

G I 

CAL 






P 

E 

AL 







n 

i 

ML 

N S I 

ON 

WSTA 

(2 

5 ) 

,01 SP 






RGX ( 

25 

) , 

C2CPX 


STA.DISP, WAKE , TT , PT , L AM, RGX , C2CPX ,FGRX) 
FOR STREAMLINES -TTPT- 

WAKE 

LAM( 25 ) 

(25) # TT ( 2 5 ) » PT ( 25 ) , 

(25) ,FGRX ( 25 ) 


INPUT* 

MA = F I R S T F IELD PU IN I 
MB = LAST F IFLD POINT 


OUTPUT - 
WST A = 
D I S P ( K ) 


WAKE = 

TT 

PT 

L AM BDA = 
RCU 

RGX = 
C2CPX = 
FGRX = 
NOTE - 


LIST OF STREAM FUNCTIUN VALUES 
=NON-Z ERO FOR POSSIBLE SLIP CONDITION BETWEEN STREAMLINE 
K AND K + l, OTHERWISE DISP(K)=0. 

DISPLACEMENT THICKNESS OF WAKE IF POSITIVE 
.TRUE. IF THERE EXISTS ANY WAKE DISPLACEMENTS. 
INTERPOLATED TOTAL TEMPERATURE 
INTERPOLATED TOTAL PRESSURE 

LAMINA THICKNESS IN THIRD DIMENSION, BLOCKAGE EFFECT 
INTERPOLATED ANGULAR MOMENTUM ***NOT NOW IN USE 

GAS CONSTANT 
SPECIFIC HEAT 

1. /(GAM-1. )= FUNCTION OF GAMMA FOR CALCULATING DENSITY 
LENGTH OF WSTA,TT,PT,RCU-LISTS IS MB-MA+1 


table of 

INDEX - 
CH 

L TNE X T=* 
LPS1 = 
NPT 
LTT 
LPT 

LRCU = 
COMMON 

1 

2 

3 


CONVECTED PROPERTIES 
LT=LTO,LTt 
CHANNELNAME 

INDEX INCREMENT TO THE NEXT CHANNEL 
RELATIVE LOCATION OF PS I LIST 
NO. OF PSI, TT, PT AND RCU VALUES 
RELATIVE LOCATION OF TT LIST 
RELATIVE LOCATION OF PT LIST 
RELATIVE LOCATION OF RCU LIST 
/CHDATA/ CH( l ),LTNEXT{ 1) ,NPT( 1) ,LPSI (1 ) 
LRCU I 1), 

CRG( 1) fCPGJ(l)« C2CP( l) , QGAM( 1 ) 
FOR ( 1) ,AREATBU85> 


♦ L TT C 1 ) 
, FGT ( 1 ) 


,LPT I 1 ) 
,FGP( 1 ) 


, 


, 


INTEGER CH 
DIMENSION XCH(l) 

FUU IVALENCE (CH,XCH) 

TABLE OF WAKE DISPLACEMENT THICKNESS 
INDEX- L W=L WO , L WE 

DIMENSION X 2 W( I ) , L WNE XT ( 1 ) ,S1WU7> 

DIMENSION DST(l) 

EQUIVALENCE (DST.S1W) 

SUBTABLE ARRANGEMENT IS- 

X 2 W , L WNE X T ( = 2 ♦ 2N ) , S 1 W ( 1 ) , S 1 Wl 2 ) . . . SI W I N ) , DSTt l) »DST(2) ,..DST 
X 2 W = STREAMLINE COORDINATE 
S1W = DISTANCE ALONG STREAMLINE FROM T.E. 

DST = WAKE DISPLACEMENT THICKNESS AS A FUNCTION OF S1W 
FLOW ADJUSTMENT TABLE 


INDEX- LF=LFO.LFE 


NFCOL S= 8 

X 1 F = ORTHOGONAL COORDINATE 



N) 


I F ( SQMD.GE . 1 . ) GO TO 920 

DPTR = 1. - ( (6.*S0M)/( SQM+5.) )**3.5 * < 6 . / ( 7 .* SQM- 1 . > ) **2 . 5 
PTR ( J ) = PTR(J) * ( l.-PDUM< 18 ) *DPTR) 

920 M = 

K = K*1 

I F ( M. LE .MB ) GO TO 910 

RETURN 

1560 FORMA 1 ( /2X57H*** ERROR IN FLOBAl, REQUESTED BOUNDARY PRESSURE EXC 
*EEDS/6X37HT0TAL PRESSURE AT TRAILING EDGE POI NTF 1 1.5 * 1H,F 1 1 .5 , IH. / 
*6X3HPS = F8.3» 3X3HP T =F 8 . 3 # ) 

END 
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♦ DUCK. L f I I 2 U 

SUBROUTINE L F I T 2D ( X , Y , TO , NX Y ) 

* L F I T 2D LINEAR SURFACE INTERPOLATION -LFIT2D- 

C IN A RECTANGULAR GRID 

DIMENSION X(2) ,Y(2 ) » TO ( 2 > 

INPUT - 

X » Y = LIST OF COORDINATES AT WHICH INTERPOLATED VALUES ARE TO BE 
NXY = NO OF COORDINATE POINTS 

NXT = NUMBER OF XT 

NY T * NUMBER OF YT 

XT = X-GRID OF T-TABLE 

YT = Y-GRID Of T-TABLE 

T = TABLE OF VALUES 

NOTt - NUMBER OF T-VALUES IS NXT*NYT, ORDER IS ILLUSTRATED BELOW 


YT (NYT )- 

T( 3) 

T (6) 

T ( NXT^NYT ) 

YT ( 2 I ~ 

T ( 2 I 

T ( 5) 

T (8) 

YT( l ) - 

T ( 1) 

T (4) 

T ( 7 1 


XT ( l ) 

X T ( 2 I 

XT ( NXT ) 


OUTPUT- 

TO = INTERPOLATED VALUES AT X,Y 

COMMON /CTHICK/ N XT , NYT » X T ( 2 0 > , YT { 20 ) , T ( 78 ) 
COMMON /ERASE / DUM< 400 I « TI ( 200 I , T2 ( 2001 

C FIND CORRECT X-INTERVAL 

I = l 

M * 1 

ISV =0 
100 NCOUN T = 0 

105 IFIXIMJ.LT. XT (1)1 GO TO 110 

I F ( X(M) .GT.XT ( 1*1 ) ) GO TO 120 
F = ( X ( M I -XT ( m/(XT(Ul)-XT( I )) 

GO TO 150 

110 I F ( I.EQ.l) GO TO 1 AO 
I = I-i 

GO TO 125 

120 IF( ( I + 1J.GE .NXT ) GO TO 145 
I =1+1 

125 NCOUN T s NCOUNT + 1 

IF(NCOUNT.GT.NXT) CALL ERROR 1 
GO TO 105 
140 F =0. 

GO TO 150 
145 F =1. 

C INTERPOLATE WRT Y 

150 I F ( l.EQ.ISV) GO TO 160 
IJ2 * I *NYT ♦ 1 

IJ1 = IJ2-NYT 

CALL LFITKYT » T ( I J 1 ) » NYT • Y.Tl.NXY) 

CALL LFITKYT, T(IJ2)tNYTt Y,T2,NXY) 

ISV * I 

C INTERPOLATE WRT X 



630 VMSQf K ) = AMAX 1 ( VMSQI K ) , 1 • E-6 ) 

IF< ABS(VMSQtK)/VMSQK-i.) .GE.2.E-5) GO TO 620 
GO TO 610 

C END INTEGRATION OF MOMENTUM EQUATION 

C *♦ INTEGRATION OF FLOW AREA 
650 AREA! 1 )=AREAO( 1 ) 

M = MA 

00 660 K = 1 * NK 

VM ( M J = SORT ( VMSU(K) ) 

IF US(K ) .LT.O. .AND. F GR C K ) . Nl . 0. ) GO TU 6N0 
RHU(K)= PT(K)/(RG(K)*TT(K)) * ( T S ( K ) / T T ( K >) **FGR ( K ) 

WO A ( K ) = RHO ( K ) * VM ( M ) 

IF(M.tQ.MA) GO TO 660 

C NOTE - AVERAGE FLOW/AREA IS APPROXIMATELY SORT ( WUA ( K-l ) *WQA ( K ) ) 

WOAVG = WQA ( K ) ♦ WQA (K- 1 ) 

X = (WQA{K)-WQA(K-1) )*(WQA(K)— WQA(K-l) ) / ( WQA VG* WOAVG) 

AREA! K )=AREA(K-1 ) ♦ 2 . * ( W ST A { K > -WSTA I K-l )> / 

1 ( WQA VG* ( l. - X* {. 5 + X* (. 125+ X*. 0625) ) ) ) 

IF ( DI SPIK-l ) .LE .0. ) GO TO 660 
PERIM = 1. 

1 F ( .NOT . AX I A ) GO TO 655 
PERIM = PI*(R(M)+R (M-l ) ) 

6 55 AREA(K)=AREA( K- 1)+DISP(K— 1)*PERIM 
660 M = M+l 

C... END FLOW AREA INTEGRATION 

C RECIPROCAL OF CALCULATED FLOW AREA, ETC. 

QAREA = l./AREAINK) 

VMRC = VM ( MB ) 

IFIPLB.LT.O. .OR. PUB.NE.O.) GO TU 7*0 
VMSQS V= VMSOINK) 

VVSAFE= VMSQSV 

IF ( VMLBSQ.NE.O. ) GO TO 710 

C CALL -UIREM- FOR THE NEXT QUE S S OF VM(NK|«VMBC 
IFIOVm.NE.O.) GO TO 680 
YO = l./TAREA 
YTOL = l.E-5*Y0 
IFIWF.NE.O.) YQ=YO*WF/WSTA(NK) 

DYDX = DWDV(L) 

I F ( DYDX.EQ.O. .OR. 0 YDX. E Q. XCHOKE ) DYDX*YO/VMBC 
I F C .NOT .CHOKE ) GO TO 675 
YO = YO+YO 
675 QAREA1= QAREA 
VUB1 * VMBC 
680 XJP = - • 75* VMBC 

IF ( .NOT .SUBSON) XJP=.25*VMBC 
CALL QIREM( VMBC, QAREA, XJP,QV) 

I F ( QV ( D.EQ.O.) GO TO 682 
IF( UV( 5 ) .EQ.O. ) GO TO 68* 

VMSO( NK )=VMBC*VMBC 
GO TO 600 

C EVALUATE D(W)/0(VLB), SAVE VELOCITIES 
682 BOT » VMBC-VUB1 
C .001 FOR COC VERSION ONLY 

IF( ABS(BOT) .GT. .001) DwD V ( L )=( QAREA- QAREA 1 )/BOT 




GO 10 740 


C TH* (LOW IS CHOKED 

6H4 |E ( CHOKE I GO TO 740 
R A I 10 = (JAREA*T AKl A 
DO 6H6 K*1»NK 
6H6 AREA! K ) = R AT IO + ARLA (K ) 

CALL ADJWF2 
GO TO 740 

C CALL -01KEM- FOR LOWER BOUNDARY PRESSURE ITERATION 

710 Yf) = VMLBSO 
YIOL = I . E~5*Y0 
DYOX = 1. 

CALL OIREM! VMSOINK ) , VMSO ( 1 1 , - . 5 * VMSQ ( NK ) , QV ) 

IF(UV( 1I.NE.0.) GO TO 600 

C CONTROL STREAMLINE VELOCITY 

715 CONTINUE 

C CALCULATE BOUNDARY PRESSURE 

740 PL BC = RHO ! I ) ♦RG 1 1 ) *TS! 1 ) 

PUBC = RHO!NK)*RG(NK}*TS!NK ) 

WRQST = WSTA(NK) 

WCALC = WRQST *Q ARE A* T AREA 

IF(PDUM(9I.LE.0.) GO TO 900 

IFUIIU.GE.POUMIB) .AND. XI ( U . LE .POUM! 9 I ) GO TO HOO 
GO TO 900 

800 CALL TABPRT ( 3HSTA»X1 CL) . 1,1) 

CALL TABPRT! 6HFB-CFB,L,33,4) 

IITAB = MA 

CALL TABPRT!5HFH-S2,S2,MB,10) 

IITAB = MA 

CALL TABPRT ( 4HPHI 1 , PHI 1 , MB, 1 3 I 
IITAB = MA 

CALL TABPRT !4HC UR V,C UR V»MB»1<J) 

IITAB -M A 

CALL TABPRT! 5HFB-VM, VM,MB,IO) 

CALL TABPRT(6HERASE2,AREA,1536,8) 

CALL TA8PRT(4HFB-W,W,NJ, 10) 

CALL TABPRT(5HFB-X2,X2,NJ,10) 

CALL TABPRT! 5HSLCHN, SLCHN,NJ, 10) 

C RESET PL B AND PUB INDICATORS 

900 PL B = 0. 

PUB = 0. 

C COMPUTE SHOCK LOSS 

IF(PDUM(18).EQ.O. ) RETURN 
K = l 

M = MA 

910 SUM = VMSQIK )/! 1.4*RG!K»*TS!KI) 

IF! SGM.LE . 1. ) GO TO 920 
CALL GETIX 

IF(MD.FU.O) GU TO 920 

VVMXSQ= VM!MD)*VM!MD)/!C2CP(K)*TT(K) ) 

SQMD = 5.*VVMXSQ/ll.-VVMXSQ> 

| 7 > 



CFGT = l./( 1.+FGRIH ) 

VMLBSQ* C2CP ( i)*TT(l ) * < 1 PLB/PT ( 1) )**CFGT) 

GO TO 540 

C FREE OR FIELO LOWER BOUNOARY 

532 !F( TYPELBIL I .NE .FREE .AND. T YPE LB ( L > . NE . F I ELO ) GO TO 534 

M = MA 

CALL GETIX 

IF(MU.EO.O) CALL ERROR 1 
VMLBSU= VMIMU)*VM(MU) 

533 PL B = i.E-6 

I F C TYPELBIL ) .NE.F I EL D .OR. PASS1) GO TO 540 
VHUBSQ= 0. 

I F ( TY PEUB { L ) .EO.F 1ELD) GO TO 570 

C STREAMWISE INTERPOLATION OF VELOCITY AT ISTAG=3 POINT BY LSPFIT 

IRET = I 
5331 M4 = M 

CALL GETRLX 
II =0 
Nil =3 

IFfM2.E0.M4) GO TO 5333 
II = I 
Nil =4 
S 1 B ( I I ) s S I ( M2 ) 

V 1 B ( 1 1 ) =VM ( M2 ) 

5333 S 1 B ( 1 l*l)»Si(M3) 

V I B ( I |«I)*VM(M3) 

S 1 B ( I I +2 ) -S 1 ( M5 ) 

VI B ( I I ♦2 I = VM ( M5 I 
S 1 B ( I I + 3 ) *S 1 ( M6 ) 

V IB ( I I+3I=VM(M6) 

IFIM6.EQ.M4) NII=NII-1 

CALL LSPFITI $1B,V1B,NI I , Sl(M) f VMM,l, 0) 

I F ( IRET ) 5335,5435,5335 
5335 VMLBSQ= VMM *VMM 
GO TO 540 

C FAR-FIELO LOWER BOUNOARY 

534 IFITYPELB(L).NE.FARFLD) GO TO 540 
CALL ERROR I 

CALL LSPFITUDN, UDN, 25, Z ( MA ) , VMLB SO , l , 0) 

VML BSQ= VMLBSO*VMLBSO 
GO TO 533 

C UPPER BOUNDARY 

540 VMUBSU= 0. 

C PRESSURE UPPER BUUNUARY 

IF I PUB. GT .0. ) GO TU 541 
IF( TYPEUBIL ) .NE.PRES) GO TO 542 
CALL LSPFIT(ZP,PPS»NZPf Z(MB),PUB,1, 0) 

541 PSB * PUB 

PTB = PT(NK) 

M = MB 

IF(PSB.GE.PTB) GO TO 568 
CFGT = 1 . / ( 1 • ♦FGR (NK ) ) 

VMUBSO= C2CPINK >*TT(NK)* < 1 PUB/P T ( NK ) )**CFGT ) 

GO TO 570 

C FREE OR FIELD UPPER BOUNDARY 

542 IF( TYPEUBIL I. NE. FREE .AND. T YPEUB < L ) . NE .F I EL 0 ) GO TO 544 

M = MB 




CALL GETIX 

IMMU.EU.O) CALL ERRUR1 
VMlJBSO* VM( MU >*VM< MU ) 

VML BSO s 0. 

543 PUB * l.E-6 

I F < T YPEUB ( L ) . NE . f I EL 0 .UR. P4SS1) GU TO 570 
iRt f =0 
on TO 5331 

5435 VMUBSO* VMM*VMM 
GO TO 570 

C FAR-FIELO UPPER BOUNDARY 

544 I F I TYPEUB(L).NE.FARFLD) GO TO 570 

CALL L SPF I T ( 7DN,UDN, 25* Z ( MB ) , VMUB SO • 1 , 0) 

VMUBSU* VMUBSO*VMUBSO 
GO TO 543 

56B WKIIF ( 6 * 1 5 6 B ) 1 ( M ) , R ( M ) , PSB , PT B 
CALL ERROR 1 

C BEGIN FLOW BALANCE ITERATION 
570 QV( 1) = 0. 

IFtVMUBSQ.NE.O. ) VMSQ ( NK )=VMUBSQ 
VMSQS V* VMSQ(NK) 

C NEGTS, VVSAFE ARE USED FOR SALVAGING NEGATIVE TEMPERATURE SITUATIONS 
NEGTS = 0 
VVSAFE* 0. 

GO TO 600 

590 NEGTS = NEGTS+I 

I F ( NE GT S . GE .20 .OR. ( PLB + PUB ) .NE . 0. ) CALL ERRORl 
VMS0(NK)=.5*(VMS0(NK I ♦VVSAFE I 

C****STEP BY STEP INTEGRATION OF NORMAL MOMENTUM EQUATION 
600 VRATIU* VMSUINK I/VMSUSV 
K = NK 

C PREDICT VELOCITY AT K 
610 K = K — 1 

I F ( K ) 615,650,615 

C COEFFICIENT VALUES AT K+ l 

615 TS(K*i)8TT(K«n-VMSQ(K*i )/C2CP(K+l) 

CDPT1 = RG(K + 1)*TS(K*1)/PT(KM) 

C COEFFICIENT VALUES AT K 

VMSUIK )=VMSO(K)*VRAT 10 
620 VMSOK = VMSQ(K) 

TS(K) = TT(K)-VMSQ(KI/C2CP(K1 
CDPT = CDPT1 ♦ RG(K)*TS(K)/PT(K) 

C INTEGRATE 

IFIOISPIKl.NE.O. ) GO TO 625 

622 VMSQIK )=VMSQ(K+l )*VVKQKP ( K ) ♦ SQRT VV ( K ) * { C DPT* ( P T ( K I -PT ( K ♦ l ) ) ) 

GO TO 630 

C (WAKE DISCONTINUITY) 

625 IF(PT(K+1).EQ.PT(K)) GO TO 622 

PSLIP = PTlK*ll*(TS(K+ll/TT(K+II)**(FGR(K+l)+l.l 
T S ( K ) = TT(K)*(PSLlP/PT(K))*Ml./( 1 • ♦F GK ( K ) ) ) 

VMSUlK)=C2CPtK)*( TT(K)-TSIKI) 

i7M- 
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C INOEX- M = MO »NM 

COMMON /CZ / Z ( 300 ) 

COMMON /CR / R ( 300 ) 

COMMON /CS2 / S2 ( 300 ) 

COMMON /CS1 / SK300J 

COMMON /CPHI1 / PH 1 1 ( 300 ) 

COMMON /CM / JMS( 300 1 
COMMON /CCURV / CURVI300) 

COMMON /CB / B( 300) 

COMMON / C VM / VM( 300» 

COMMON /ClOfcX / M , J , MU » Ml) , I S I AG 

COMMON / 1 XOR 1 (>/ IHOtLMLt LBDO.LBDL, LTQ.LTE* LWQ,LWE, LFO.LFE, 

* LO.LESTA, L OUM ( 8 I , 

* MO »NM , NJ,NFCOLS, MAXNJ»MAXOL ,MAXNM,MAXLE * 

* LEO, LEE, LRO,LRE,LRO 

DIMENSION LIM1TS(24) 

EQUIVALENCE (LIMITS, LHO) 

COMMON /CBEND / NBCB ( 2 ) » ANGE (2) ,CURVE(2),FB(2) 

COMMON /CB I TS / BITS, BLANK 

COMMON /CCUBE / NBC ( 2 ) ,C 1 ( 2 ) , C2 ( 2 ) , F END 1 2 ) 

COMMON /CGRAV / CG 

COMMON /CPI / Pi, TWO PI ,PIQ2,PIQ4,T0DEG, TOR AO 
COMMON /CREFIN/ SGI , SG2, VMG1 , VMG2 

l, NGR, NGZ, SGR l 10 ) ,GR(10) , SGZ ( 10) ,GZ 1 10 ) 

COMMON /SLTAB / W ( 12 8 ) , X2 ( 1 2b ) » SLCHN ( L2B I 
INTEGER SLCHN 
COMMON /SLTAB2/ PTR(128) 

STATION TARLt 
INDEX- L=LO,LESTA 

SCHOKE= STATION CHOKE INDICATOR ( ADJWF ,BRHS, WRIOUT ) 

MCL = SHARP CORNER INDICATOR IBLDTBSI 

MCL = FIELD index of control streamline (PTMOVE ,FL0BAL) 

COMMON /CHDATA/ X 1 11) , LNl XT ( 1 ) , MLB (1 ) f MUB (1) , PRl M ( 1 ) , 

1 TYPE LB (1) »NAMELB( 1 1 , ILB(1 ) ,FLB(l ) ,S1LB( 1 ) , 

1 TYPEUBI 1 ) ,NAMEUB( 1 ) , IUBC1 ) ,FUB(1 ) , S1UB( 1 ) , 

3 VMB< 1) ,DWDV( 1 ), X2CH1)»VCL(1)*MCU481) 

LOGICAL PRIM 

INTEGER TYPELB, TYPEUB 
DIMENSION SC HOKE ( 1 ) 

EQUIVALENCE ( SCHOKE , D WDV ) 


COMMON /CFB2 / PASS1 
LOGICAL PASSi 

COMMON /CFRFIN/ AT INF , M I NF , R F F I NF , UI NF , Z DN1 , Z DN2 5 
COMMON /CFRFLD/ NF F ( 1 30 ) , ZDN ( 50 ) , UDN l 2 5 ) 

COMMON /CIDEXR/ M* ,C 1 1 (4 ) ,M3 v Cl 2 (4 ) *M5 >CI 3 (4 I »M2 «CI4 (* ) • M6 tC I 5 U ) 
COMMON /CISBOT/ C I SDUM ( 7 ) , NZ P , ZP I 10 >» PPS ( 1 0 ) 

COMMON /CLSPF / I, LEND / 


LOGICAL 


LEND 


COMMON /C PRINT/ PH TE S2 ( 6 ) , PDOMI 20 1 
COMMON /COIR EM/ YTOL , YQ, DYDX ,CTRMAX 
COMMON /CTABPR/ UTAH 



INTEGER FARFLO,FREE ,PRE S,F I ELD 

LOGICAL WAKE 


DATA FARFLD/6HFARFL0/, F REE / 4HF REE / , PRES/4HPRES/ , F IELD/5HF IELD/ 



Oo I) MA = ML H f l I 

Mil = MUB ( L ) 

IHL.LC1.LUI CALL SLTMCU1., PIR,NJ) 

C C.HtCK FOR STAGNATION BOUNDARY POINT 
M = MA 

CALL GETIX 

IF I ISTAG.NE.l ) GO TO 515 
MA = MA+l 

515 M = MB 

CALL GETIX 

IF ( ISTAG.NE.l) GO TO 520 
MB = M B- 1 

C BUILD UBLE OF FLOW FUNCTION AND STAGNATION CONDITIONS 

520 CALL TTPTIMA.MB, W ST A , D I SP , WAKE » T T , P T . L AMBDA # R(,,C2CP,FGK) 

C PASSAGE AREA AND SHOCK PRESSURE LOSS 
K = 1 

M = MA 

522 RLAMDA(K)=LAMBDA(K ) 

IF ( AX 1A ) RLAMDAIK ) =T WOP I *R ( M ) *L AM8DA I K ) 

CALL GETIX 
P T ( K 1 = PTIK)*PTK( J) 

K = K + l 

M = M + i 

IF(M.LE.MB) GO TO 522 
ARE AO ( 1 ) =0 . 

NK = MB-MA+1 

LEND = .FALSE. 

IFINK.GT.2 .AND. (DISPI2 I .Nt .0. .OR. 01 SP I NK-2 ) . NE . 0 . ) ) U. N0= . 1 RUE 
CALL LSPFIT ( S2IMA ) ,RLAMUA f NK» S 2 I MA ) ♦ ARE AO , NK , -1) 

T AREA = AREAO(NK) 


C INTEGRATE CURVATURE WITH RESPtCT TO S2 
C INITIAL ESTIMATE OF MERIDIONAL VELOCITY SQUARED 
SDNORM= 0. 

CALL LSPF IT ( S2IMA) , C UR V ( MA) » NK » S2 I MA ) t SDNQRM , NK , -1 ) 

LEND = .FALSE. 

M =* MA+l 

DO 52 5 K = 2 » NK 

V VK QK P(K— 1)=EXP(2.*( SDNQRM ( K ) -SDNQRM ( K- 1 ) ) ) * TT ( K- 1 ) / T T ( K ) 
SQRTVV(K-1)=SQRT(VVKQKP(K-1) ) 

VM$Q(K-l)=VM(M-l)*VM(M-i ) 

525 M = M + l 

VMSQINK )=VMB(L)*VMB(L) 


C 

c 


SPECIFIED STATIC PRESSURE AND SPECIAL 
VMLBSQ* 0. 

PRESSURE LOWER BOUNDARY 
IFIPLB.GT.O.) GO TO 530 
IF ( TYPELBIL ) .NE.PRES ) GO TO 532 
CALL LSPFIT(ZP,PPS,NZPt Z(MA),PLB,1, 
530 PSB = PLB 

PTB = P T ( 1 ) 

M * MA 

IF( PSB. GE. PTB) GO TO 56B 



BOUNDARY OPTIONS 


0) 



C (BELOW THE BODY) 

125 IF(x2(JB).EQ.X2F(LF) ) X1BF ( LF )*X1 ( L ) 

C (ABOVE THE BOOY ) 

IF( X2( JA) .EQ.X2F( LF) ) Xl AF ( LF )* XI ( L ) 

RETURN 

C CHOKED CHANNEL W/O T.E., ADD A LINE TO /CADJWF/ 

200 LF = LFE+l 

IF(LF.NE.LO) GO TO 205 
NMOVt = LO-L) STA-1 
LO = LO+NFCOLS 

CALL MOVEd, X 1 I L F ) * X l ( LO ) *NMOVE * 1 ) 

CALL SF TM ( 1 ,0 » X l F ( LF ) , NFCOL S ) 

L = L ♦NFCOL 5 

LSJfc = L 5 IF ♦NFCOL 5 
LESTA = LL ST A^NFCOLS 
LFE = L FE ♦NFCOL S 
205 X 1 F (LF ) =X 1 ( LSTE ) 

X2F(LF )=X2( JA ) 

X1AF(LF)=X1(L) 

X1BF( LF ) = X1F(LF ) 

J ORDER ( L F ) =- 1 

C WRITE COMMENT 

800 WRITE (6,1800) XI ( L ) ,L 

1800 FORMAT ( / 1 X32HUNEXP EC TED CHOKE, STATION (XII I *F6. 3 t4X2HL* 14* ) 
I F ( LSTE.EQ.O) CALL ERROR 1 
RETURN 
END 
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♦DECK F 10 HAL 

SUBROUTINE FLDBAL 
♦FLOHAL FLOW RALANCl 


koutinl 


1 N T L GK A T I ON Of T HI CONTINUITY A NO NORMAL 
ALONG THT ORTHOGONAL S TO THE STREAMLINES 


-F LORAL - 


MOMENTUM EQUATIONS 


INPUT 

L 

PL H 

PUB 


WF 

CHOKE 


INDEX IN THE STATION TABLE 
LOWER BOUNDARY STATIC PRESSURE 
UPPER BOUNDARY STATIC PRESSURE 
EITHER PLB OR PUB fJR BOTH MUST 
IF PLB (OR PUBI =-i, NO ITER 
PRESSURE IS PERFORMED. 

FLOW RATE IF KNOWN (OVERRIDES VALUE OF WSTA) 
T FOR CALCULATION OF MAX FLOW 


IF 

KNOWN. 

IF 

KNOWN. 

BE 

ZERO. 

ION 

FOR FLOW OR 


S 2 ( M ) = DISTANCE ALONG I HE OKTHOGONOL 


( M ) 

= STRE AML I 

N 1 

CURVA I URL 



I UN 

TABLE 





L ) = 

ESTIMATE 

D 

VELUC I T Y ON 

THE UPPER 

BOUNDARY 

(L ) 

= DER I VAT I 

VE 

OF THE AREA 

INVERSE 

WITH RESPECT 

AML 

INE TABLE 






TO BOUNDARY Vf. 


OUTPUT 
PL BC 
PUBC 
TAREA 
WCALC 
WRQST 
VMBC 


CALCULATED LOWER BOUNDARY PRESSUREt M = MA 
CALCULATED UPPER BOUNDARY PRESSURE, M = MB 
TOTAL PASSAGE AREA FUR ALL STREAMTUBES 
CALCULATED FLOW 
REQUESTED FLOW I SLTAB DATA) 

CALCULATED VELOCITY UN THE UPPER BONNOARY 
UWDV( L ) =OERIVAT IVE OF THE AREA INVERSE WITH RESPECT 
VC L ( L ) = VELOCITY UN THE CONTROL STREAMLINE 
PLB, PUB=0 • IRESET FOR NEXT tNTRY) 


TO BOUNDARY Vf 


COMMON /ALLCOM/ 

MACHA,PSA,T$A,PTA,TTA, AXIA,RGA, 

GAMA , 


MACHC,PSC,TSC*PTC,TTC, AXIC,RGC, 
DAXIT, SCALEA.TTEtCHOTST 

GAMC, 

REAL 

M ACHA ( i ) , MAC HC 


LOGICAL 

AX IA , AX I C 


LOGICAL 

CHOTST 


COMMON /CFB / 

L , MA , MB , PLB , PUB , WF , CHOKE , SUBSON, 

NK, PLBC , 


XCHOKE, TAREA, VMBC, WRQST, WCALC, 
J SUM , VMLti SQ 

OV (8 ) ,QV 

LOGICAL 

CHOKE, SUBSON 


DIMENSION 

SlB(4)»Vlfl(<r) 


EQUIVALENCE 

( S IB , QV ) , ( V 1 B * Q V ( 5 ) ) 


COMMON /ERASE 2/ 

AREA (96) , ARE A0( 96) ,DI SP( 96 ) , P T( 96 ) , L AMBDA 


R HOI 96 ) , SORT VV( 96 ) , T S ( 96 ) , T T ( 96 ) 

, VMSQI96) 


V VKQK P (96), 



WQA(96),WSTA(96), RG ( 96 ) , C 2C P ( 96 

) , F GR ( 96 ) 

REAL 

LAMBDA 


DIMENSION 

ES2( 96 ) , SONQRM ( 96 ) 


EQUIVALENCE 

( ES2 , VVKQKP ) , I SDNQRM, RHO) 


D I MENS ION 

RCU( 96 ) 


EQUIVALENCE 

(KCU, LAMBDA) 


DIMENSION 

RLAMDA(96 ) 


EQUIVALENCE 

( RLAMDA, AREA ) 
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♦DECK ADJWF2 

SUBROUTINE A0JWF2 

* AD JWF2 INSERT CHOKE STATION IN FLOW ADJ-T ABLE -ADJWF2- 


FLOW ADJUSTMENT TABLE 
INDEX- LF =LFO,LFE 
NFCOL S= 8 

X 1 F = ORTHOGONAL COORDINATE 

X2F = STREAMLINE COORDINATE OF SL EMINATING FROM T.E. 

XIBF = X i-COORO I NAT E OF CHOKE STATION OF FLOW BELOW T.E. 

X 1 AF = Xl-COORDINATE OF CHOKE STATION OF FLOW ABOVE T.E. 

SIF = SI-COORDINATE OF T.E. (UPPER SURFACE). THIS ITEM 
IS USED WHEN INTERPOLATING FOR WAKE DELTA-STAR. 
LFBtLFA= INDICES OF STATIONS BELOW AND ABOVE T.E. 

NCHB,NCHA=N UMBER OF CHANNELS BELOW AND ABOVE T.E. 

LRF = INDEX OF DUMMY ORTCHN LIST FOR THE T.E. 

IRXF = INDFX OF LAST CHANNEL BELOW THE T.E. 

JORUFK= 0 IT IOIAL FLOW Af XiF IS GIVEN 
-2 IF T LOW ABOVE T.E. IS GIVEN 
= 1 IF FLOW BELOW T.E. IS GIVEN 
JORCE K= -1 If FLOW AT XlF IS CHOKED AND SINGLE CHANNEL 
COMMON /C HD AT A/ X 1 F ( I) , X 2F (I) ,X 1BF 1 1 ) , XI AF I 1 ) » 

1 SIF ( 1) ,NCHB( I ) ,NCHA(l ) , JORDER(I) • VNR( 12) 

EQUIVALENCE ( LFB , X IBF ) t ( LFA , XIAF ) , ( LRF , NCHB) , ( LRXF .NCHA ) 

DIMENSION LFR( 1) »LFA(I ) ♦ L RF ( 1 ) t LRXF II) 

STATION TABLE 


INDEX- L=LO f LESTA 

SCHOKE= STATION CHOKE INDICATOR ( ADJWF*BRHS,WRIOUT) 

MCL = SHARP CORNER INDICATOR (BLDTBS) 

MCL = FIELD INDEX OF CONTROL STREAMLINE ( PTMOVE »FLOBAL ) 

DIMENSION XI (1 ),LNEXTU),MLB(l),MUB(l) tPRIM(i) » 

1 TYPELBd ) ,NAMELBU),ILB(L) ,FLBII) .SILB(i) , 

I TYPEUB (I ) tNAMEUB ( 1 ) » IUB(i) , FUBU ) • SiUB U ) • 

3 VMB(I) ,DWDV( 1). X2CLC1) ,VCL(l) «HCLU8L) 

PR IM 

TYPFLB, TYPEUB 


LOGICAL 
INTEGER 
OIMENS ION 
EQUIVALENCE 

DIMENSION 

EQUIVALENCE 

equivalence 

equivalence 

equivalence 

equivalence 

equivalence 

equivalence 

equivalence 

equivalence 

equivalence 

equivalence 

COMMON /CFB 


1 


LOGICAL 
COMMON / CSS 

INTEGER 

LOGICAL 


SCHOKE(l) 

( SCHOKE, DWDV J 
T AR ( 6 ) 

( CHNAM » 8DT «CH«X2W»X1F*X1) 

(LHNE XT »LBNEXT »L TNE XT » LWNEXT »X2F» LNEXT ) 

( WTFLCW»LB2lfNPT,SIWf XIBF, MLB) 

( T TO* CHNAME ♦ LPSI • XIAF, HUB)* ( PTO, UP, LTT, SIF , PR I M ) 

( TSO, LEDEX,LPT,NCHB,TYPELB) 
(PSC,ZBT,LRCU,NCHA,NAMELB) 

(MACHO.RBT * CRG * JORDE R . I L B ) , ( AO , ANGBT ,CPGJ ♦ VNR, FLB ) 
( VARY,C2CP»SILB) » (RG.QGAM, TYPEUB) 

( GAM* FGT» NAMEUB) , ( NR »FGP ♦ I UB ) , ( NC,FGR*FUB) 
(TAB(1)»AREATB»S1UB)» ( TAB ( 2 ) , VMB ) , ( TAB ( 3 ) , DWDV ) 
(TAB(4)»X2CL)* (TAB(5),VCL), (TAB(6),MCL) 

/ L*MA,MBfPLBfPUBfWFfCHOKE»SUBSON» NK,PLBC, PUBCt 
XCHOKE ♦ T ARE A , VMBC t WRQST,WCALC, 0VI8 ) , 0VP( 8) , 
JSUM, VMLBSQ 

CHOKE ,SUBSON 

/ SSFML ,SSEF*SSLANG»SSDF , SSFEND ,SSFNDi 
.SSDLE,AAFACT,BRLX,CURRLX 
SSFML 




\ 


SS £ F » 


SSDF i SSDLE 



oooooooonn 


SSFML = SUPERSONIC CURVATURE FORMULA NUMBER 

‘.SET = SUPERSONIC ENTERING FLOW, T OR F 

S S E AN G = ENTERING FLOW ANGLE (DEGREES) FOR SSEF=T 

GSUf = SUPERSONIC DISCHARGE FLOW, T OR F 

SSF END= SUPERSONIC BEAM OOWNSTRE AM END CONDITION, =0 

S SF NO I = SUPERSONIC BEAM UPSTREAM END CONDITION, =0,1 

SSDLF = SS FLOW HELOW AND AFT OF LE PT, T OR F 

A4F AC T= CENTRAL POINT INFLUENCE COEFFICIENT FACTOR 

BRLX = B-REL AX AT I ON FACTOR 

CURKL X = CURVATURE RELAXATION FACTOR 

COMMON /IXORIG/ LHO, LHE , LBOO ,LBDE , LTQ,LTE, LWO,LWE 

LO,LESTA, LDUMI8), 

MO,NM, N J ,NFCOL S , MAXN J ,MAXOL ,MAXNM, 
LEO, LEE, LRO » LRE , LRD 
DIMENSION LIMITS(2A) 

EQUIVALENCE (LIMITS, LHO) 

COMMON /SLTAB / W ( 128 ) ,X 2 ( 128 ) , SLCHN ( 128) 

INTEGER SLCHN 


* 

* 

* 


COMMON /CIDEX / M, J,MU,MO,ISTAG 


C CHECK FOR SMALLER PREVIOUSLY DECTECTED AREA 
M = MLBIL ) 

CALL GET IX 
JA = J 
M = MUB ( L ) 

CALL GET I X 
JB * J 
JSUML = J A+256* JB 
IF( JSUM.NE. JSUML) GO TO 90 
IF( TAREA.GT.SVAREA ) RETURN 
90 JSUM = JSUML 
SV ARE A= TAREA 
IF(SSDF) $UBSON=* FALSE. 


c search forward to trailing edge 

LX = L 
LSTE = 0 

105 IF( .NOT.PRIM(LX) ) GO TO 110 
M = MIB(LX) 

CALL GET I X 

IF(J.NE.JA) GO TO 115 
M = MUB(LX) 

CALL GET I X 

IFU.NE.Jfi) GO TO 115 
LSTE * LX 

no lx * lx+lnextilx) 

IF ( LX .LT.LESTA) GO TO 105 
115 IF(LSTE.EO.O) GO TO 800 

C SEACH CADJWF-T ABLE FOR T. E . VALUE OF XI 
LF = LFO 

120 IF(LF.GE.LFE) GO TO 200 

IF(X1F(LF ).EQ.Xl(LSTE) I GO TO 125 
LF = LF+NFCOLS 
GO TO 120 

C IS T Ht L-ORTHOGONAL BELOW OR ABOVE THE BODY 


,1 FOR PARABOL 
, FOR PARABOLA 

♦ LFO»LFE , 
MAXLE, 
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DIMENSION 8DTI I) .LBNEXT (l ) , LBZlt l) • 

1 CHNAME ( 1 ) »UP l 1) , LEDEXl 1 ) , 

2 ZBT( I) ,RBT(1) ,ANGBT(«2) 

LOGICAL UP 

INTEGER BDT ♦ CHNAME » BONA ME 

DIMENSION BDNAMEI 1 ) ,LB A ( 1 ) , LBB ( 1 ) 

EQUIVALENCE < BONAME , ZB T ) , (LBA.RBT), ( LBB* ANGBT ) 

FLOW ADJUSTMENT TABLE 
INIH X- t F *1 FO.LFL 
NFCOL S= H 

X I F = ORTHOGONAL COORDINATE 

X2F = STREAMLINE COORDINATE OF SL EMINATING FROM T.E. 

X 1BF = X 1-COORD I NATE OF CHOKE STATION OF FLOW BELOW T.E. 

X1AF = X 1 -COORD I NATE OF CHOKE STATION OF FLOW ABOVE T.E. 

S1F = SI-COORDINATE OF T.E. I UPPER SURFACE). THIS ITEM 
IS USED WHEN INTERPOLATING FOR WAKE DELTA-STAR. 
LFB,LFA=INDICES OF STATIONS BELOW AND ABOVE T.E. 

NCHB,NCHA=NUMBER UF CHANNELS BELOW AND ABOVE T.E. 

LRF = 1NOEX OF DUMMY ORTCHN LIST FOR THE T.E. 

LRXF = INDEX OF LAST CHANNEL BELOW THE T.E. 

JOROCR= 0 IF TOTAL FLOW AT XiF IS GIVEN 
= 2 IF FLOW ABOVE T.E. IS GIVEN 
= 1 IF FLOW BELOW T.E. IS GIVEN 
JORDfc R = -1 IF FLOW AT XIF IS CHOKED AND SINGLE CHANNEL 
DIMENSION XlF(l) ,X2K 1) ,XIBF<1) .XiAFU) . 

I S1FC 1) ,NCHB( 1 ) * NCHAI I) .JORDER ( 1) ,VNR(12) 

EQUIVALENCE ( L FB , X 1BF ) f < LF A , X 1 AF ) « ( LRF ,NCHB) , (LRXF.NCHA) 
DIMENSION LFB( l),LFA(l),LRF(l),LRXF(l) 

STATION TABLE 
INDEX- L=LO,LESTA 

SCHOKE= STATION CHOKE INDICATOR ( ADJWF , BRHS.WRIOUT ) 

MCL = SHARP CORNER INDICATOR I BLDTBS ) 

MCL = FIELD INDEX OF CONTROL STREAMLINE C PTMOVE *FLOBAL ) 

COMMON /CHDATA/ X 1 ( 1 ) , LNE XT ( 1 ) t ML B ( 1 ) , MUB ( 1 ) , PRI M ( l ) , 

1 TYPELB(I) «NAMELB(l)f ILBU) »FLB(1 1 » SILBC 1) , 

1 TYPEUB(l) »NAMEUBU)»IUBU)tFUBm,SlUB(l), 

3 VMBI 1 ) »DWDV( 1 ) t X2CLI1) « VCL ( 1 ) .MCL ( A81 ) 

LOGICAL PRIM 

DIMENSION SCHOKEU) 

EQUIVALENCE ( SCHOKE , DWDV ) 

EQUIVALENCE ( BDT , X IF , X 1 ) f (LBNEXT »X2F»LNEXT)» ( LBZ 1 1 XIBF » MLB ) 

EQUIVALENCE ( CHNAME » X l AF » MUB ) » I UP ♦ S IF , PR I M) 

EQUIVALENCE ( L E DE X , NCHB , T YPE LB ) , ( Z BT , NCHA , NAMELB ) 

EQUIVALENCE (RBT, JORDER, ILB) , ( ANGBT ,VNR ,FLB) 

COMMON /CTABPR/ I l TAB 

CALL TABPRT(6HALLCOM,MACHA,2D,8) 

CALL TABPRTI 3HCFB,L» 33, A) 

CALL TABPRT(5HCIDEX,M,5,5) 

I1TA8 = LBDO 

CALL TABPRT( 6HBDYTAB ,BDT ,LBDE ,3 ) 

I1TAB = LFO 

CALL TA BP RT(6HC ADJWF, XIF ,LFE ,8) 

I IT AB = LO 

CALL TABPRT( 6HSTATAB.X1, LESTA,5 ) 

150 WRITE (6,1150) ( J , X2 ( J ) » SLCHN ( J ) , W ( J ) , J= 1 , N J » 




CALL TAHPRT ( 5 HE R A St , t R AS E C , 800, 5 ) 

CALL JMSPRT 

CALL TABPRT(2HS1, S1,NM, 10) 

CALL TABPRT(2HS2,S2,NM,10> 

CALL IABPRT ( 1 HZ * Z * NM , 1 0 ) 

CALL TABPRK lHR,R f NH,10) 

CALL TABPRT(AHPHI1,PHII,NM,10> 

CALL TABPRT(AHCURV#CURV»NM,10 J 
CALL rABPRT(2HVM,VM»NM*10) 

CALL TARPRT ( 1HB,B»NM,10) 

CALL T ABPRH 6HE R A SE 2 , ARE A , 15 36, 8) 

L STOP = 3 

GO TO (<599,999) , LSTOP 
999 RETURN 

1150 FORMAT ( /// IX 1 7HSTREAML INE TABLE-/ l 7X32HJ X2 

* W/( I 18,F12.6, 6X,A6,F 12.6, ) . > 

END 


SLCHN 


♦ DECK 

♦ CFfl- 


CFB 

BLOCK DATA CFBBLK 

BLOCK DATA FOR CFB -CFB- 

COMMON /CFB / L # MA » MB * PLB» PUB # WF f CHOKE t SUBSON* NK.PLBC . PUBC t 

XC HOKE * TAREA , VMBC * WRQST * WCALC* QV t 8 > «QVP ( 8 ) , 
J SUM , VML BSO 

LOGICAL CHOKEtSUBSON 

DATA XCHOKfc/SHCHOKE/ , JSUM/O/ 

END 




oooooooooo 


* DECK EKKUKX 

SUBROUTINE ERROR 1 

CEOUMPX EDUMP FOR STC EXECUTE SECTION -EDUMPX- 


C 

C 


COMMON /ALLCOM/ M ACHA , PS A , T S A ,P T A , T T A , AX I A , RGA, GAMA , 


1 

2 


REAL 
LOGICAL 
LOGICAL 
COMMON /CFB 


l 

* 


MACHC,PSC,TSC»PTC»TTC» AX I C ,RGC , GAMC t 
DAXIT,SCALEA*TTE»CHOTST 
MACHAI 1 ) , MACHC 
AXIA.AXIC 
CHOTST 

L ,MA, MB, PLB, PUB, WF, CHOKE, SUBSON, 

XC HOKE , T ARE A , VMBC , WRQST,WCALC, 

J SUM , VMLBSQ 


NK , PLBC , PUBC , 
QV ( 8 ) » QVP ( 8 ) , 


1 

2 
2 


LOGICAL CHOKE, SUBSON 

COMMON /ERASE / EKASEC(0OO) 

COMMON /ERASE 2/ AR EA ( 96 ) , ARE AO ( 96 ) , DI SP ( 96 ) , P T ( 96 ) , L AMBDA ( 96 ) 

R HOI 96 1 , SQRTVVI 96 ) , TS ( 96 ) , TT ( 96 ) ,VMS0(96> ♦ 
VVKQKPI 96 ) , 

WUA(96),WSTA(96)» RG ( 96 ) ,C2CP ( 96 ) ,FGR(96) 


» 


REAL 

DIMENS ION 
EQUIVALENCE 
DI MENS ION 
EQUIVALENCE 
FIELD TABLES 


LAMBDA 

E S 2 ( 96 ) , SDNQRMJ 96 1 
( ES2, VVKQKP) , (SDNQRM,RHO) 
RCUI96I 
(RCU, LAMBDA) 


INDEX- M=MO,NM 
COMMON /Cl / 2(300) 
COMMON /CR / R ( 300 ) 
COMMON /CS2 / S2 ( 300 ) 
COMMON /CS1 / S 1 ( 300) 
COMMON /CPHI1 / PH 1 1 ( 300 ) 
COMMON /CM / JMSI300) 
COMMON /CCURV / CuRV(300) 


C 


COMMON /CB / B ( 300 ) 

COMMON /CIDEX / M , J , Mu, MO , I S TAG 
TABLE OF INDEX LIMITS 

COMMON /IXORIG/ LHO, LHE , LBDO ,LBDE , LTO, LTE , LWO,LWE, LFO , LF E , 

* LO»LESTA, LDUM ( 8 ) , 

* MO , NM , N J *NFCOLS, MA XN J , MAXOL , MAXNM , MAXL E , 


DIMENS ION 

equivalence 

COMMON /CVM 


LEO, LEE, LRO , LR E , LRD 
LIMITS<24) 

(LIMITS, LHO) 

VM( 300) 


C STREAMLINE TABLE 

COMMON /SLTAB / W ( 1 2 8 ) , X 2 ( 1 2 8 ) , SLCHN ( 128 ) 

INTEGER SLCHN 
BOUNDARY TABLE 
INDEX- LB=LBDO,LBDE 

LBNEX T - INCREMENT TO NEXT BOUNDARY 

LBZI = INCREMENT TO THE FIRST BOUNDARY POINT (=0 BEFORE COALLATIO 
CHNAME= CHANNEL WITH WHICH THE BOUNDARY DATA IS ASSOCIATED 
UP = T OR F FOR UPPER OR LOWER BOUNDARY 

LEDEX = RELATIVE INDEX OF L.E. POINT WHEN LOWER AND UPPER SURFACE 
CONTOURS ARE CONNECTED 

BDNAME,LBA,LBB=NAME AND INDEX LIMITS OF SPECIFIC BOUNDARY 

DATA WHEN BOUNDARIES ARE COALLATED 



ooooo ooo 


♦DECK RTCFI 

SUBROUTINE RTCF I ( CHT l , LH ) 

♦RTCFI- RETRIEVE CHANNEL FLOW INPUT -RTCFI- 

INPUT- 

CHDAT A = CHANNEL INPUT DATA TABLE 
CHT I = CHANNEL NAME 

out pui - 

LH = INDEX OF CHT L IN THE CHANNEL DATA TABLE 
=0 IF NO CHANNEL DATA WAS FOUND 
IF THEY EXIST, THE CHDAT A-L l STS TT,PT»RCU ARE TRANSFERRED TO THE 
LISTS OF TT,PT,RCU. IF THEY DO NOT EXIST, TT,PT,RCU = BITS. 


INTEGER CHT I 
COMMON /IXORIG/ 

* 

* 

* 

DIMENS ION 
EQUIVALENCE 


LHOtLHE » LBDO.LBDE, LTO.LTEt LWO,LWE, LFO.LFE, 
LO,LESTA, LDUM 18), 

MO ,NM , NJ.NFCOLS, MAXN J » MAXOL , MA XNM , MAXLE , 

LEO, LEE, LRO , LRE , LRD 
L IMITS124) 

(LIMITS, LHO) 


COMMON /CBITS / 
COMMON /CHDATA/ 

1 

2 

4 

INTEGER CHNAM 

common /erase/ 

1 

DIMENS ION 
EQUIVALENCE 


B ITS .BLANK 

CHNAM ( 1) , LHNEXT ( l ) , WTFLOW( 1 ) , TTO , PTO, 
TSO(l) ,PSO( 1 ) .MAC HOI 1) ,AO(l) ,VARYU ), 
RG(l).GAMII), NR I 1 ) ,NC(I) ,TAB(6> » 
li I 75) 

QV(8),EDUM(72), A (90 ) , VI 90 ) * 
PSI(90),R(90),TT(90) ,PT(90) ,RCUI90) , PS I 90) 
Y ( 90) 

( Y , R ) 


NAMELIST /NLCHN / PS I ,R, Y ,TT , PT ,RCU, PS 


C SEARCH CHDATA FOR CHANNEL =CHT l 
LH = LHO 

60 IF(LH.GE.LHE) GO TO 65 

IF (CHNAM(LH) .EQ.CHTl ) GO TO 70 
LH = L H + L HNE XT ( LH ) 

GO TO 60 

C NO INPUT TABLE WAS FOUND 

65 LH =0 

RETURN 


C AN INPUT TABLE WAS FOUND 

70 CONTINUE 


C PLACE THE TABLE IN COMMON-1 RASE 
NCR = NC ( LH ) *NR ( LH ) 

I F ( NCR . GT .0 ) CALL I SORT ( T T , P T ,RCU, B I LH ) , NCR ) 

RETURN 

END 

OVERLAY(STC,2,0) 




♦DECK STCB 

PROGRAM STCB 

COMMON /CHNFPT/ I CHN ( 10 ) , WTF S (1 0 ) , WTF A ( 1 0 ) , WPTO< 1 0 ) , WTTO ( LO ) , IC 
COMMON /SELECT/ LENTRY 
GO TO (10.20), LENTRY 

C NORMAL ENTRY — STATION LOOP, FLOW BALANCE 
10 CALL OVERLAY! 3HSTC ,2 , 1 .6HRECALL ) 

GO TO 30 

20 CALL OVERLAY! 3HSTC ,2 ,2,6HKECALL ) 

CALL OVERLAY! 3HSTC ,2. 3.6HRECALL ) 

30 RETORN 
END 




oooooonoo 


♦ OECK RRCONV 

SUBROUTINE RBCONV 

* RflCUNV REBUILO CONVECTEO PROPERTIES TABLE -RBCONV- 


C COLLECT LIST OF CHANNELS FROM /CONVTB/, THEN BUILD A 

C NEW /CONVTB/ FROM CHANNEL DATA TO ACCOUNT FOR INPUT MODIFICATIONS 


TABLE OF CONVECTEO PROPERTIES 
INDEX- LT = L TO,L TE 
CH = CHANNELNAME 

L TNEX T = INOEX INCREMENT TO THE NEXT CHANNEL 
LPSI = RELATIVE LOCATION OF PSI LIST 

NPT = NO. OF PSI, TT, PT AND RCU VALUES 

LTT = RELATIVE LOCATION OF TT LIST 

LPT = RELATIVE LOCATION OF PT LIST 

L RCU = RELATIVE LOCATION OF RCU LIST 

COMMON /CHDATA/ CH ( 1 ) , LTNEXT (1) ,NPT (1) , LPS I ( 1 ) ,1 TT 11) *LPT (1) , 

1 LRCU(l), 

2 CKGI l ) ,CPGJ 1 1 1 ,C2CP( l ) » QGAM ( 1 ) ,FGT ( 1 ) ,FGP ( l ) , 

3 FGR( II ,AREATB(485I 


* 

♦ 


iNTfcGER CH 
DIMENSION XCH ( 1 ) 
EQUIVALENCE (CH.XCH) 
COMMON /IXORIG/ LHO, LHE , 

LO,LESTA, 
MO.NM, NJ 


DIMENS ION 
COMMON /SL TAB / 
INTEGER SLCHN 


LEO, LEE, 
LIMITSI2A 
W ( 128 ) ,X2 


LBDQ ,LBDE * LTO,LTE * LWO.LWE, LFO.LFE 
LDUM18) , 

,NFCOL S , MAXNJ,MAXOL ,MAXNM f MAXLE , 

LRO,LRE»LRD 

I 

( 12B ) » SLCHN ( 128) 


, 


COMMON /CFB2 / 
LOGICAL 

COMMON /ERASE2/ 
COMMON /SPACER/ 


PASSl 
PASS 1 

CHTI 500) »AT( 500 ) ,F L W ( 500 ) 
MAXLH.MAXLT, MAXLF, MAXLW 


C 


INTE 

GER C 

HT 

ACCUMULA' 

IE channel 

NAMES 

LT 

= 

L TO 


I 

= 

0 


I 

= 

I +1 


CHT ( I 

) = 

CHILI) 


ATI I ) 

= 

ARE ATR ( L T 

) 

LTl 

= 

LT+LPSl (L 

T l+NPTI 

FLWI I 

I = 

xchil ri ) 


LT 

- 

LT + LTNF XT 

(LT I 

IF (LT 

.LI 

r.LTt) GO 

TO 110 

N I 

= 

I 



AND AREAS 


L T I - i 


C CYCLE THROUGH BCONV ROUTINE 
PASSl = .FALSE. 

LTE = LTO-1 

I = l 

130 CALL BCONVICHTI I I ,LT,AT( I I I 
C CHECK FOR CHANGED FLOW RATE 

LT = LT+LPSI (LT l+NPTI LT )-l 

IF(XCH(LT ) .EQ.FLWI I) ) GO TO 190 




c update the streamline table flow values 

C SEARCH FOR FIRST ANO LAST ELEMENTS OF SLCHNt J ) = CHT ( I ) 

DO 140 J As 1 f N J 

140 IF ( SLCHNl JA) .EO.CHTm ) GO TO 150 
150 CO 160 J = J A » N J 

IF( SLCHNl J ).NE.CHT( I ) ) GO TO 170 
160 JB = J 

C SCALE THE CUMULATIVE FLOW RATE VALUES 

170 DO 180 J * J A » J B 
1 BO WtJ) = WI J)/WI JB )*XCH(LT ) 

C SET P A SS 1 = T TO JUMP AROUND INTERPOLATION FOR VM IN FLOBAL 

C ( T Y PE = F I ELD ) 

PASS1 * .TRUE. 

190 I = 1 + 1 

I F ( I.LE.NI ) GO TO 110 

IF(LTE.LT.LWO) GO TO 9B0 

WRITE <6, I960! L TO , L TE , M A XL T , L WO 

CALL ERROR 1 

980 RETURN 

i960 FORMAT ( / 1X69H*** THE TABLE OF CONVECTED PROPERTIES HAS EXCEEDEO A 
♦ LLOCATED MEMORY . / 6 X4HLT0= 1 4 , 3X4HLTE * 1 4 » 3X6HMAXLT * 1 4 , 3X4HL W0= 1 4 , ) 
END 


1 




80MSL A = 0. 

I F ( UP ( L B ) ) RDMSLA = P I 
GO TO 120 

105 LB2 = LB*LEDEX( LB)-3 
BOMSL A = PI 

IF(CHNAM£(LB).EQ.NAMCHN) GO TO 120 
LB1 = LB2 + 3 
LB2 = LB20 
BOMSL A* 0. 

IF (CHNAME (IB+l ) .LO.NAMCHN) GU TO 120 
CALL ERROR! 


C 


C 


C 

C 


120 FGE1 = .FALSE. 

DO 150 L B-LB1 «L B2 » 3 
DZ = ZBT (LB+3J-ZBT (LB ) 

OR = RHT(LB+3)-RBT(LB ) 

SB = SORT < OZ*OZ ♦OR*OR I 

I F ( SB.EQ.O. ) GO TO 150 
CSB = DZ/SB 

SNB = OR /SB 

AP = ANGLE OF THE PERPENDICULAR OR ORTHOGONAL 

AP = • 50*APT ♦ .50*(ATAN3(DR ,DZ , APT+BDMSLA ) -BDMSLA ) ♦ PIQ2 

SNP = SIN(AP) 

CSP = COS(AP) 

D = SIN(AB-AP) 

D = SNB*CSP-CSB*SNP 

IF(ABS(D).LT..01I GO TO 150 
XP * XPT-ZBT(LB) 

YP = YPT-RBT(LB) 

SS = ( YP*CSP-XP*SNP J/0 
F = SS/SB 

1 F ( F.GE .1 .0001 ) GO TO l<*0 
IFIF.GT. (-.00011 .OR. FGE1J GO TO 200 
1 .Lt.-.OOOl 
GO TO 150 
F .Gt. 1.0001 
1 50 FGE1 = .TRUE. 

150 CONTINUE 


C FAILED TO FIND PROPER BOUNDARY INTERSECTION 
APT D = APT*TODEG 

WRITE (6,1950) NAMBD Y, XP T , YPT ,A PTO 

C FIRST OR LAST INTERVAL 
LB = LB1 

F = . 1 

I F C .N0T.FGE1) GO TO 165 
LR * L B2 

F = .9 

165 DZ = ZBT { L B ♦ 3 ) - Z B T (LB ) 

DR = R B T ( L () ♦ 3 ) - R B I (LB ) 

WRITE (6,1960) 

200 ANGCHU= A I AN 3 ( DR , l)f , ANGM I ( LB ) ) 

F = AMAX1 (0..AMIN1IF , 1. I ) 

G = l.-F 

Y P A = ANGBT ( l B ) -angchd 

YPB = ANGBT (LB + 3 )-ANGCHD 




RZONL Y = 
CALL BFI 

.false . 

I 

<LB-LB10O)/3 

FA 

F 

SI 

SIM 

XH 

ZBT (LBJ+ZM 

YB 

RBTILBURM 

RZONL Y= 
RETURN 

.TRUE. 


1950 FORMAT ( /1X61HERRUR- THE INTERSECTION OF A L.E. OR T.E. 
♦WITH THE/6X14HB0UNDARY, BDY=A6*A0H, WAS NOT FOUND* THE 
♦POINT IS/6X2HX=F10.5, 3X2HY*F 10. 5* *XAHANG=F 8. 3 , > 

1960 FORMAT ( /6X5BHTHE INTERSECTION POINT IS BEING PLACED IN 
♦RVAL ./6X2AHEXECUT ION WILL CONTINUE.) 

END 



orthogonal 

L.E. /T.E. 
AN END INTE 



on non 


*0E CK JOFCHN 

SUBROUTINE JOFCHN (CHN, JA , JB ) 

♦JOFCHN STREAMLINE INDEX FROM CHANNEL NAME -JOFCHN- 


INPUT- 

CMN = NAME OF CHANNEL 

JA = STREAMLINE FOR WHICH SEARCH WILL BE INITIATED 
OUTRUI - 

JA.JIS = FIRST AND LAST INDEX OF STREAMLINES BELONGING TO CHN 

INTEGER CHN 
COMMON /IXORIG/ 

* 

* 

* 

DIMENS ION 
EOUI VALENCE 
COMMON /SLTAH / 

INTEGER SLCHN 

LOGICAL SECOND 

S ECONO = .FALSE. 

J = JA 

55 l F ( CHN. NE . SLCHN ( J J ) GO TO 65 
I F ( SECOND ) GO To 60 
SECOND* .TRUE. 

JA = J 

60 JB = J 

GO TO 70 

65 IF< SECOND) RETURN 
70 J * J+i 

IFIJ.LE.NJ) GO TO 55 
IF( .NOT. SECOND) CALL ERRORl 
RETURN 
END 


LHO, LHE , LBDOtLBDE , LTOtLTE , LWO,LWE, LFO»LFE , 
LO.LESTA, LDUM(B), 

MO,NM, N J tNFCOLSt MAXN J , MAXOL » MAXNM , MAXLE • 

LEO, LEE, LRO,LRE,LRD 
L IMITSI24 ) 

(LIMITS, L HO) 

W( 128) ,X2( I2B), SLCHN (128) 




oooooooooo ooooo oooooo 


*uf ck rmi 

SUBROUTINE UBI ( XPT ,YPT, APT, NAMBDY, NAMCHN, I . F A , S l , XB , YB ) 

*iJHl ORTHUGONAL-BUUNUARY intersection -obi- 

input- 

XPT - X-COOR OF PT ON THE ORTHOGONAL 

YPT = Y-COOR OF PT ON THE ORTHOGONAL 

APT s ANGLE OF SL PERPENDICULAR TO ORTHOGONAL 
NAMBDY* BOUNDARY NAME 

NAMCHN* NAME OF CHANNEL ADJACENT TO NAMBDY 


OUTPUT- 

I * INTERVAL OF ORTHOGONAL-BOUNDARY INTERSECTION 

FA * FRACTIONAL POSITION IN THE INTERVAL 
SI * ARC DISTANCE FROM BEGINNING OF THE INTERVAL 
XB,Yt\ * COORD INA I E S UF THE INTERSECTION 

BOUNDARY TABLE 
INDEX- LB=LBOO,LBDE 

LBNEXT* INCREMENT TO NEXT BOUNDARY 

LRZ 1 - INCREMENT TO THE FIRST BOUNDARY POINT (=0 BEFORE COALLATIO 

CHNAME* CHANNEL WITH WHICH THE BOUNDARY DATA IS ASSOCIATED 
UP * T OR F FOR UPPER OR LOWER BOUNDARY 

LEDEX * RELATIVE INDEX OF L.E. POINT WHEN LOWER AND UPPER SURFACE 
CONTOURS ARE CONNECTED 

BDNAME»LBA,LBB=NAME AND INOEX LIMITS OF SPECIFIC BOUNDARY 

DA I A WHEN BOUNDARIES ARE COALLATED 
COMMON /CHDATA/ BDT(1 ) , L BN6 X T ( i ) , LBZ 1 1 1 > , 

1 CHNAME I 1)« UP ( 1) *LEDE X ( 1 ) , 

2 ZHT< I),RBT(IJ,ANGBTU2) 

INTEGER CHNAME 

LOGICAL UP 

DIMENSION BDNAMEll ),LBAIi ),LBB(1> 

EQUIVALENCE ( BDNAME » ZBT ) , { LBA ,RBT ) f ( LBB ♦ ANGBT ) 

COMMON /CBEAM2/ DR ,DZ , YP A , YPB , F ,G , DX»YQDX,ZM,RM, ANGM, CURVM » SIM, 

1 RZONLY, ANGCHD, SINTVL, YPASQ,YPAB t YPBSQ 

LOGICAL RZONLY 

COMMON /IXORIG/ LHO.LHE, LBDO,LBDE, LTO.LTE, LWO,LWE, LFO,LFE, 

* LO.LESTA, LDUM(8), 

* MO.NM, NJfNFCOLSt MA XN J » MAXOL » MA XNM , MAX LE , 

+ LEO, LEE, LRO, LRE , LRD 

DIMENSION L I M I TS C 2 4 ) 

EQUIVALENCE (LIMITS, LHO) 

COMMON /CPI / PI ,TWOPI , P I Q 2 ,P l Q4 , TODEG , T ORAD 
COMMON /TROUBL/ ERR , ERRM A J , I NERR , PRE RR 
LOGICAL ERR,ERRMAJ,INERR» PRERR 

LOGICAL FGEl 


C 


DETERMINE INTERVAL INDEX LIMITS, LB 1 , LB2 , 
LB * LBF(NAMRDY) 

LB 10 - LB + LBZKLB) 

LB20 * LB+LBNEXT(LB)-12 
LBI * L B 10 
LB2 * LB20 

IFUEDEX(LB).NE.O) GO TO 105 

BDMSL A* BOUNDARY MINUS STREAMLINE ANGLE 


OF -NAMBDY- 

,C(> 



ooooo no o o o 


♦DECK BWAKE 

SUBROUTINE BWAKEl JX,THK> 

♦BWAKE- BUILD WAKE TABLE -SHAKE- 

INPUT- 

JX = WAKE STREAMLINE 

THK = T.E. THICKNESS 

COMMON /IXORIG/ l HO, LHE » LBDU»LBDL , LTO»LTE, LWQ.LWEt IFO.LFE. 

♦ LOtLESTA i LUUM (HI, 

♦ MO.NM, NJ.NFCOLS, MA XNJ .MAXOL ,MAXNM, MAXLE * 

♦ LEO, LEE, LRO,LRE ,LRD 

DIMENSION LIMITS(2A) 

EQUIVALENCE (LIMITS, LHO) 

COMMON /SLTAB / W( L28),X2(128I,SLCHN(L28) 

INTEGER SLCHN 

TABLE OF WAKE DISPLACEMENT THICKNESS 
INOEX- LW=LWO,LWt 

COMMON /CHDATA/ X 2 W 1 1 ) ,L WNE XT ( l ) « SI W (47 ) 

DIMENSION DST(I) 

EQUIVALENCE (DST.SlW) 

SUBTABLE ARRANGEMENT I S- 

X2 W, L WNE X T ( =2*2N ) , S 1 W ( 1) , S 1 W( 2 ) . . . SI W { N) , DST( I ) . DST ( 2 I , . . DST ( N ) 
X2W = STREAMLINE COORDINATE 

S1W = DISTANCE ALONG STREAMLINE FROM T.E. 

DST = WAKE DISPLACEMENT THICKNESS AS A FUNCTION OF S1W 

IF(THK.EO.O. I RETURN 
IE(LWE.GT.LWO) GO TO IIO 
LW = L WO 
IIO X2W(LW )=X2( JX ) 

S l W ( L W I =0 . 

S 1 W ( L W+ 1 )=10. # ABS( THK ) 

SIW(LW + 2I=S1W(LW+1 ) 

SlWlLW43)=SlW<lW+2)+SlW(LW+2) 

DST (LW + A )=THK 
DST(LW45I=0. 

DST ILW46) =0. 

DST(LW+7)=0. 

N = A 

LWNEXT(LW)=2+N+N 

LW = LW+LWNEXT ( LW ) 

L W E = L W- I 

IF (THK.LT.O.) WRITE (6,1200) THK,X2(JX) 

1200 FORMAT ( A 1 H ♦♦♦ ERROR - NEGATIVE T.E. THICKNESS OF .Fil.5, 

1 BH AT X I 2- * F7. 3« 1H . ) 

RETURN 

END 




♦DECK FILL 

SUBROUTINE F I L L I X « Y , NA , NB ) 

CFILL 

C LINEAR INTERPOLATION To FIL VACANCIES IN INPUT LISTS 
COMMON /CB ITS/BITS 
DIMENSION X( 1 0 ) » Y ( 10) 

C FIND IAtIB - VACANT REGION 
I A = NA + 1 

IF( YI I A- 1 ). EQ. BITS) GO TO 99 
3 DO A I 3 I A * N B 

IF( Y< I ).NE.BITS) GO TO 5 
A CONTINUE 
I B = NB 
GO TO 7 
•» IH-I-I 

IF I I .tQ. I A ) GO TO 12 
C FILL VACANCIES 

IF( YI IB + 1 ).NE .Y( IA-1 ) ) GO TO 9 
C ALL VALUES THE SAME 

7 DO 8 I 1 = 1 A, IB 

8 Y( I I ) =Y( l A-l ) 

GO TO 12 

C INTERPOLATE 

9 OX = X| IB+1) - XI IA-1 ) 

DO 11 II*IA«1B 

11 YIII) * ( Y< IB + 1 )♦( X( II I-XIIA-1) I ♦ YUA-n*(X(IB + l)-XUI) ) )/DX 

C GO BACK AND SEARCH FOR MORE REGIONS 

12 IA = I B+2 
IF(I.LT.NB) GO TO 3 

99 RETURN 
END 




LR2 - LRXFtLF J-LROIF 
DO 1115 LK=LRO,LR2 
LRX = LR+IRCIF 

If (CHNA(LRX I .FQ.BLANK .OR. JOHN A ( LR ) .EQ . 1 ) GO TO 1115 
NHL NK 1 = NBLNK 1 ♦ l 
IF(J.tC.O) J= JCHNA( LR ) 

1F( JCHNA(LR).NE.J) J =- 1 
1115 CONTI NUI. 

NBL NK 2 = 0 
L R 3 = LR2+1 

DO 1120 LR=LR3,LR4 
LRX = LR+LRDIF 

IF(CHNA(LRX).EO. BLANK .OR. JCHNAI LR ) . EQ. 1 ) GO TO 1120 
NBLNK Z~ NBLNK2+1 
I F c JCHNA(LR).NE.J) J=-l 
1120 CONTINUE 

C SET STATIONS ABOVE T.E. TO NBLNK 2 

C THE FLOW IS KNOWN IF NBLNK=J 

IF{ (NBLNK 1+NHLNK2 I .EO.OI GO TU 1140 

IF ( NMLNK2.E0.0I GO TO 1130 

JOROE K ( L F ) = 1 

DO 1125 LR=LK3,LR4 

LRX = LR+LKOIF 

1125 IF ( CHNA ( LRX ) .NE .BLANK .AND. JCHNA ( LR ) . NE . I > JCHNA ( LR )«NBLNK2 
C SET STATIONS BELOW T.E. TO NBLNK1 

1130 I F ( NBLNKi.EO.O) GO TO 1136 
JORDER ( LF ) =2 
DO 1135 LR =LRO , LR 2 
LRX = LR+LRDIF 

1135 IF(CHNA(LRX).NE. BLANK .AND. JCHNA (LR ). NE . 1 ) JCHNA ( LR )= NBLNK 1 

C IS THE TOTAL FLOW KNOWN 

1136 IF ( NBLNKI.EO.O .OK. NBLNK2.EQ.0 ) GO TO 1138 
JORDER ( LF ) =0 

IFl J.EC.(-l)) GO TO 1140 

C INDEX TO NEXT T.E. ORTHUGONALS 

113b NCHBI LF )=NBLNK1 
NCHA( LF )=NBLNK2 
X1BF(LF)=X1F(LF ) 

X1AF( LF ) = XIF( LF I 

LF = LF+NFCOLS 

IF ( LF .Lr.LFE I GO TO U12 

C ELIMINATE GAPS BETWEEN EUUIVAlfcNCED TABLES 
1139 NMOVE = LWE-LWO+1 

CALL MOVEd, X2WILW0) »X2W(LTE + i It NMOVE ♦ 1 ) 

L WO = ITE + i 
LWE = LTE ♦NMOVE 

NMOVE = LFE-LFO+l 

CALL MOVE ( 1 * XIF(LFO) »X1F (LWE + i ) » NMOVE » 1 I 
LEO = LWE+1 
LFE = LWE+NMOVE 

NMOVE = LESTA-LO+l 

CALL MDVEI1, XI IL0)'X1(LFE*1) » NMOVE, 1) 




L (J = L FE ♦ 1 
LLSTA = L F E +NMOVL 

C INITIALIZE R 

CALL SETMt 1, 1 ./ 1024. , B,NM) 

RETURN 

C ERROR- 

1 1 AO WRITE I 6, HAD LF 
CALL ERROR 1 

1056 FORMAT ( /2X60H*** ERROR- ONE CHANNEL MUST HAVE A FIXED FLOW RATE IV 
*ARY=F ) ./I 3X31HNO SUCH CHANNEL COULD BE FOUND. / 13 X7HNCHT0T = I 2 » 3XAHN 
*FA=I2, 3X6HNCHBA=I 2» ) 

1560 FORMAT ( 1XA7HERR0R- CONNECTING EDGES WERE NOT FOUND FOR CHN=A6,22H 

♦ (SUBROUTINE BLDTBS)) 

1 1 A 1 FORMAT! /1X61H*** PROBLEM ENCOUNTERED IN THE ORDERING OF FLOW ADJU 
*STMENTS./6x 9HINDEX LF=I3,22H. PLEASE SEEK ADVISE. ,10H (BLDTBS ) ) 
1835 FORMAT ( /1XA7H*** ERROR- NEGATIVE RADIUS ENCOUNTERED, AXl=T., 

* 10H (BLDTBS)) 
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X2CL(L)=X2CL(L+20) 

GO TO 950 
940 X2CUL)=BITS 
950 L = L +20 

GO TO 935 

960 L = L0 

I F ( X2CL1L l.Nt.BITS) GO TO 9B0 
M = ML B ( L ) 

CALL GET1X 
X2CKL ) =X 2( J ) 

C BUILD WAKE DISPLACEMENT THICKNESS TABLE, /WAKETB/ 

980 IF1LFE.LE.LF0) GO TO 1139 
LF = LFO 
990 LBX = LFBILF) 

LAX = LFA(LF) 

ANGTE = SIFILFI 

C THE MEAN T.E. ANGLE WAS TEMPORARILY STORED IN S1F 

Ml = MUB (LBX) 

M = MLB(LAX) 

DZ 2 1 = Z ( M ) -Z « Ml I 

DR 2 1 = K ( M ) -R ( M 1 ) 

THK = DZ21*DZ21 + DR2l*DR21 
IF ( THK.EO.O. ) GO TO 995 

DANG = ATAN3I DR 21,0221, ANGT t I-PIQ2-ANGTE 
THK = COS(DANG)*SQRT(THK) 

995 CALL GETIX 

CALL HW AK E ( J » T HK I 
LF = LF ♦NFCOL S 
IF1LF.LT.LFE) GO TO 990 

C SEARCH FCR TRAILING EOGE ORTHOGONAL WHICH CONTROLS FLOW RATES 
C NF A = NUMBER OF FLOW ADJUSTMENTS *N0. OF TE-S 

NF A = (LFE+l-LFOI/NFCOLS 
NCHTOT= NJ/2 
FIXCHN = 0. 

LF = LFO 

1005 IF(LF.GE.LFL) GO 10 1055 
C STATION BELOW T.L. 

L = LFB(LF) 

J0RDFR1LF ) = 1 

CHANNEL NAME (A SINGLE CHANNEL ABOVE OR BELOW T.E. IS REOD FOR FI 
PROGRAM MODIFICATION MAY 71, THE SINGLE CHN REQUIREMENT 
FOR FIXCHN IS REMOVED. NUMBER OF CHANNELS BELOW OR ABOVE 
TE FOR FIXING THE FLOW MUST BE LESS OR EQUAL TO TOTAL 
NUMBER OF CHANNELS MINUS NUMBER OF TE-S. 

1010 M = MLB(L) 

CALL GETIX 
CHX = SLCHN(J) 

JLB = J 

M = MUB 1 L ) 

CALL GETIX 

C IF1CHX.NE.SLCHNI J) ) GO TO 1040 

NCHBA = (J+l-JLBI/2 

IFINCHBA.GT. (NCHTOT-NFA) ) GO TO 1040 
C SEARCH CHDATA TABLE 
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1 0 1 5 L H = L HO 

1020 IF ( LH.GE .LHE I GO TO 1035 

If (CHNAM(LH).EO.CHXI GO TO 1030 
l.H = LH + LHNEXT ( LH) 

GO TO 1020 

1030 FIXCHN = 1 
IF(VARY(LH)) GO TO 1040 

1035 F!XCHN= CHX 

WRITE (6,1031) FIXCHN 

1031 FORMAT ( 8H FIXCHN=,A6) 

GO TO 1060 

C STATION ABOVE T.E. 

1040 IF ( J0RDFR(LF ) .EQ.2) GO TO 1050 
L = LFA(LF) 

JOROE R ( LF ) -2 
GO TO 1010 

C INDEX TO NEXT X1F IN FLOW ADJUSTMENT TABLE 

1050 LF = LF+NFCOLS 
GO TO 1005 

1055 IF(FIXCHN.NE.l) GO TO 1060 

WRITE (6,1056) NCHTOT ,NF A ,NCHBA 

ORDER THE FLOW ADJUSTMENT TABLE 
1060 IF(LF.EO.LFO) GO TO 1100 
1060 LFF = LF 

L FT = LFO 

1070 IF (LFF.LE.LFT ) GO TO 1100 

CALL MOVE ( 3 , X 1 F ( L FF >, XX , NFCOLS , 1 , 

1 XIF(LFT) ,X1F (LFF ), NFCOLS, 1, 

2 XX, XIF(LFT) .NFCOLS, I) 

LFF = LFF-NFCOLS 

LF T = LFT +NFCOLS 

GO TO 1070 

DEFINE FLOW ADJUSTMENT ORDER, JORDER(LF) 

FIND INDEX OF -FIXCHN" IN /ORTCHN/ AND INITIALIZE 
1100 LR4 = LRO+LRD-3 

DO 1105 LR=LK0,LR4 

LR2 * LR+LRD 

1105 IF(CHNA(LR) .EO. FIXCHN .OR. CHNA ( LR2 ) . EQ. F I XCHN ) GO TO 1110 
1110 CALL SETMd.O, JCHNA , LRD- 2 ) 

JC HNA ( L R ) = 1 

LOOP THROUGH FLOW ADJUSTMENT TABLE OF TE STATIONS, DETERMINE 
IF FLUW IS KNOWN BELOW T.E. (J0RDER*1), ABOVE T.E. (J0RDER=2), 

OR IF TOTAL FLOW ABOVE+UELOW T.E. IS KNOWN (J0RDER=0). 

JCHNA ( LR ) = 1 INDICATES FLOW FUR THAT CHANNEL IS KNOWN, VALUES LARGE 
THAN UNE INDICATE THAT THE TUTAL FLOW FOR THE SEVERAL CHANNELS 
IS KNOWN. 

LF = LFO 

COUNT NUMBER OF CHNS BELOW T.E. AND ABOVE T.E. FOR WHICH FLOW RAT 
IS NOT KNOWN, I.E. JCHNA( LR ) . NE . 1 
1112 J =0 

NRLNK 1= 0 

LRD I F = LRF ( LF )-LRO 




LRX2 = LRPRV+LRD-3 
DO 866 LRX=LRPRV,LRX2 
866 IF(CHNA(LRX ) .EO.CHNX ) GO TO 925 
C DID NOT FIND CHNX, SAVE LRPKV 

IF(LRPRSV.NE.O) CALL ERROR 1 
L RPRS V= LRPRV 

C FIND UPSTREAM POUNDARY WHICH INCLUDES CHANNEL CHNX 
870 LR = LR+LRO 

CALL SETMI I, PLANK, L EDGL ( LR I , LRD ) 

LRE = LK+LRU-i 
LRPRV = LRO+LRD 
LRPI = LRPRV 
LRP2 = LRPl+LRD-i 
DO 872 LRP=LKPI*LRP2 

872 I F ( CHNAI LRP ) .EQ.CHNX I GO TO 873 
CALL ERROR 1 

873 LR 1 = LR+LRP-LRPl 

CHN A ( L R 1 ) =CHNX 

LR2 = LR1 
LRPI = LRP 
LRP2 = LRP 

C SEARCH FOR CHANNELS BELOW CHNAILR1) 

875 DO 876 LE 1 =L EO , LE E , 1 0 

876 IF(NLE(LE1 ) .NE.O .AND. C HL ( LE 1) .EQ.CHNA < LR 1 )) GO TO 878 
GO TO 896 

C CHECK FOR BOTTOM CHANNEL 

878 I F ( C HU (LEI ) .EQ. BLANK ) GO 10 884 
C USE CHU(LEl) AS PART OF THE UPSTREAM BOUNDARY 

880 LRPI = LRP 1- 1 
L R 1 = LRl-1 

IF (CHUlLtl ) .FO.CHNAI LRPI >) GU TO 882 
IFCLRI.GT.LR> GO TO 880 

GO TO 896 

882 CHNA( LR 1 ) =CHU (LEI) 

GO TO 875 

C SEARCH FOR CHANNEL ABOVE LR2 

884 DO 888 L E 2 = L EO , L E E , 1 0 

888 IF(NLE(LE2).NE.O .AND. C HO I LE 2 ) . E Q.C HNA { LR2 )) GO TO 892 
GO TO 896 

C CHECK FOR TOP CHANNEL 

892 IF(CHL(LE2).E0. BLANK) GO TO 899 
C USE CHL ( L E 2 ) AS PART OF THE UPSTREAM BOUNDARY 

894 LRP2 = LRP 2+ I 
LR 2 = LR2 + 1 

IF(CHL(LE2). EQ.CHNA ( LRP2 ) ) GO TO 898 
IF ( LR2.LT .LRE ) GO TO 894 
896 CALL ERROR 1 

C REFER ALSO TO EFN 876, 882,888, FOR THE ERROR 

898 CHNAI LR2 ) =CHL (LE2 ) 

GO TO 884 

899 LE = LEI 

UPT = .FALSE. 

GO TO 672 
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TRAILING fc OGE PT WITH ORTHOGONAL S ON BOTH SIDES. BUILD DUMMY 
LRPKV-LIST TO REPRESENT COALESCING OF UPPER AND LOWER STREAMS. 
LOOK BACK FOR ORTHOG ON OTHER SIDE OF T.E. 

900 00 904 LRP*LRO,LRE ,LRO 
904 IF(LEDGE(LRPI .EC.LE) GO TO 908 
908 LEDGE ( LRP )=-LEDGE ( LRP) 

LRX1 = LRP 
LRX2 = LR 
LR = LR+LRO 
LRX = LR 
LR E = LR+LRD-3 

CALL SETM( 1, BLANK .LEDGE (LRI.LRD) 

LEDGE (LR)=0 
LRPREVILR ) = LRX2 

910 IF (CHNA(LRXl) ,NE. BLANK) CHNA I LRX ) =CHNA I LRXl ) 

IF ( CHNA ( L RX2 ) .N£ .BLANK ) C HNA ( L R X ) = CHNA l LRX2 ) 

LRX 1 = LRX1 + 1 

LRX2 = LRX2+1 
LRX = L R X ♦ 1 
IF( LRX.LE.LRE ) GO TO 910 
LRE = LRE+2 

C BUILD FLOW ADJUSTMENT TABLE, /CADJWF/ 

L M 1 = L -20 

X1FILF ) =X 1 I LM 1 ) 

X2F (LF ) = X 2 C LI L M l ) 

S 1 F ( L F ) =ANGE ( LE ) 

DO 911 LM2=L0,LESTA,20 

911 IF(X1(LM2).E0.X1(LMD) GO TO 912 

912 IF(UPT) GO TO 913 
LFBILF )=LM2 
LFAILF )=LM1 

LRXFI LF ) = L R l- 1 ♦LKD 
GO TO 914 

913 LFB(LF)=LMl 
LFAILF )=LM2 
LRXFI LF )=LR2*LR0 

914 LRF(LF)=LR 
VNRILF )= 0. 

LF = LF+NFCOLS 

LFE = LF-1 

GO TO 920 

C DOWNSTREAM BOUNOARY, ARE ALL L.E. ORTHOGONAL COMPLETED 

915 I F I LRPRV.NE .0 ) GO TO 925 
1FILRPRSV.EQ.0) GO TO 930 
LRPRV = LRPRSV 

GO TO 925 


920 LRPRV = LR 
925 LR = LR+LRD 
GO TO 640 


C*** RELOCATE CONTROL STREAMLINE, X2CL, 
930 L = LO 

935 IF! (L+20) .GE.LESTA) GO TO 960 

IFIX1IL + 20).LE.X1(L) ) GO TO 940 
IFIX2CLIL+20) .EQ.BITS) GO TO 950 


TO THE FIRST PRIMARY OF REGION 
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MD =0 
ISTAG = 0 
CALL SAVIX 

ADD CHANNEL FLOWS FOR LATER INTERPOLATION OF SL POSITION 

IF NOT AN UPSTREAM BOUNDARY, USE UPSTREAM AREAS IN PLACE OF FLOW. 

-USE CURV FOR STORAGE 

WSL (M ) = 0. 

IF(M.EQ.MI) GO TO 830 
WSL ( M ) = WSL (M-l )+W( J ) 

IF ( MSAV.EO.O) GO TO 830 

AREA = SORT! (R(MU)-R(MUMl) ) * (R (MU)-R I MUMI ) ) ♦ 

1 ( Z I MU I-Z I MUMI ))*(Z (MU ) -2 (MUMI) )) 

IF( AXIA) AREA=(R(MU)+R(MUMl) ) *ARE A 
WSL ( M )= W SL ( M- 1 ) + ARE A 

830 MM = MM ♦ 1 
MUMI = MU 

IF ( JSL.EO. JNXT ) GO TO 835 
J SL = JNXT 
GO TO 810 

INCREMENT TO NEXT CHANNEL 
835 LRN = LRN + 1 

IFILRN.LE.LR2) GO TO 805 


INTERPOLATE FOR COORDINATES 

IF(. NOT. AXIA .OR. R(Ml).GE.O.) GO TO 836 
WRITE (6,1835) 

CALL ERROR 1 

836 DZ21 = Z(M2)-Z(M1) 

DR 2 l = R ( M2 ) -R (Ml) 

DR S02 1 = 0R21*(R(M2 ) + R(Ml ) ) 

RM 1 SO = R(M1)*R(M1 ) 


S2 ( Ml) = 0. 

S2( M2 )= SORT ( OZ21*DZ21+DR21*OR21) 

V M ( M 1 ) = VMINIT 

VM ( M2 ) = VMINIT 
MP = Ml + i 

MM = M2- 1 

IF(MM.LT.MP) GO TO 8<*0 
DO 838 M=MP , MM 

V M ( M ) = VMINIT 

F = l WSL(M)-WSLIMI) ) / ( WSL (M2 ) -WSL ( Ml ) ) 

Z(M) = Z(Ml)+F*DZ2i 
R ( M ) = R ( M 1 ) +F *DR 2 1 

S 2 ( M ) = F*S2(M2) 

I F ( .NOT. AXIA) GO TO 838 
R ( M ) = S0RT(RM1S0*F*DRSQ21> 

S2 ( M ) = SQRT( (R(M)-R(Mi) ) ♦ ( R ( M) -R ( Ml ) ) ♦ ( F*DZ2 l )* ( F*DZ2i ) ) 
838 CONTINUE 

FINISH OUT STATION TABLE 
CHECK FOR L.E., T.E. OR SHARP CORNER 
LE = INDEX OF PT IN LETEPT-TABLE 
NLETF = 0 IS A SHARP CORNER 
8 AO X 1 ( L ) = B.*FLOAT( ( LE ♦ 1 -LE 0 ) / 10) 

LNEX T ( L ) = 20 
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TYPtLH(L)= SOL I D 
TYPtllim 1 = SOL ID 
X2CL I L ) =B I T S 

IFINLETE.EQ.il GU TO 848 
I F ( UPT ) GO TO 842 
C U P T = F 

X 2C L I L I =X 2 I J1I 
M * ML B ( L ) 

GO TO 843 
C UPT=f 

842 X2CL(L)=X2(J2) 

M = MUBILI 

843 CALL GETIX 
IF(NLE(LE).NE.2I GO TO 845 
I STAG * 1 

IF (UPT) GO TO 844 
! Y PEL B I L )=HLF 
GO TO 845 

844 TYPEUBI L I=HLE 

845 1F(NTE(LE).NE.2) GO TO 847 
ISTAG = 2 

IF I UPT ) GO TO 846 
TYPELBIL )=HTE 
GO TO 847 

846 TYPEUB(L)=HTE 

847 IFINLETE.EQ.OI ISTAG=MCL(L) 

CALL SAVIX 

I F ( ISTAG. EO. II VMIMJ =0. 

848 VMBIL I * VMINI T 
DWDVI L )=0. 

VCL I L J = VMBIL) 

PR IM( L I = • TRUE . 

M = MUB ( L I ♦ 1 

L = L ♦LNE XT ( L ) 

LESTA = L-l 

C* INDEX TO NEXT ORTHOGONAL 

LOOK FOR ORTHOGONALS 10 BE PLACED ABOVE L.E. POINTS 
IF THIS IS A DOWNSTREAM BOUNDARY OR LOWER T.E. ORTHOG 
850 IF(NTE(LE I.EO.O) GO TO 920 
I F ( NTEILE I .EO.l I GO TO 855 
C NT E( LE I = 2 

IF(NUSED(LE I.E0.2 I GO TO 900 
855 LRX * LR 
860 LRX = LRPREV(LRX) 

C L RPRE V= BLANK FOR UPSTREAM OR DUMMY ORTCHN-LISTS 

IF I LRPREVILRX I .EQ. IBLANK I GO TO 862 
IFILEDGE(LRX).LE.O) GO TO 860 
LRPRV = LRPREVILRX) 

GO TO 864 

862 LRPRV = LRPRSV 
L RPRS V= 0 


C IS THE CHANNEL ON THE OTHER SIDE OF THE T.E. 
864 !F(NTE(LE).NE.2I GO TO 915 
CHNX = CHU(LE) 

IF(UPT) CHNX=CHL ( LE I 
IF I LRPRV. EO.O) GO TO 870 



IN THE LRPRV-L 1ST 
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S 1LBI L ) =S INTVL 
I UB ( L ) = 1 
FUBIL >= 0. 

S 1UB( L ) =0 . 

7 15 Z ( M 1 ) = X E I L E 1 ) 

R I M l ) = Y F I L E 1 ) 

ZIM 2) = XEILL2) 

RIM/) - Y I III 2 > 

1.0 ID HOO 

FIND IE HR T E ORTHOGONAL LOWER BOUNDARY INTERSECTION 
PLACE DATA IN STATION TABLE 
USE LETEPT-TABLE TO DETERMINE NAME OF UPPER BOUNDARY 
720 I F ( NLETE.EQ.2 .OR. NLETE.EQ.O) GO TO 722 
CALL ERROR I 

722 IFI.NOT.UPT) GO TO 740 
DO 725 LE1=LE0,LEE,10 

725 IFICHLILED.E0.CHNAILR1II GO TO 726 

726 NAMELBIL )=BDL (LEI ) 

NAMEUBI L ) =BDU I LE ) 

CALL OBI I XEI LE ) , YE (LE ) , ANGE I LE ) , BDL I LE l > tCHL I LEL ) , 

1 ILB(L) , F L B ( L ) , S 1 LB I L ) , Z(M1),RIM1)) 

C SEEK POINTER TO BOUNDARY TABLE 

LB = LBF (NAMEUBIL ) ) 

IRET = 1 

IFINTEILE ) .NE.2) GO To 728 
C TRAILING EDGE 

IV = 1 

LB = LB+LBZ 1 1 LB ) 

GO TO 733 

C leading EDGE OR CORNER 

728 LBI = LR + LRZ 1 1 LB ) 

LB2 = LB+LBNEXT (LBI-9 
IV = 1 

DO 730 L B = L B 1 » L B2 » 3 

IF(ZBTILB).EO.XEILE) .AND. RBTI LB ) .EQ.YE ( LE ) ) GO TO 732 
730 IV = IV-H 
CALL ERROR 1 

C TEMPORARILY STORE SHARP CORNER INDICATION IN MC L ( L ) (I. 

C JUMP OF MORE THAN 0.5 DEG.) 

732 MCL (L )= 2 

IF! NLETE.EQ.O .AND. ABS I ANGB T I L B ) - ANGBT I LB+3 ) ) .GT . .0087 ) 
IF( IRET ) 733, 753, 733 

733 I UB I L ) = IV 
FUBIL )= 0. 

S1UBI L ) =0. 

ZIM2) = ZBT(LB) 

R I M2 ) = RBTILB) 

GO TO 800 

C FIND LE OR TE ORTHOGONAL UPPER BOUNDARY INTERSECTION 
C PLACE DATA IN STATION TABLE 

740 DO 745 LE2 = LE0, LEE , 10 
745 IF(CHU(LE2).EQ.CHNA(LR2) ) GO TO 747 
747 NAMELBIL )=BDL (LE) 

NAMEUBIL ) =BDU(LE2 ) 

CALL OBKXE(LE) , YE I L E ) ,ANGE I LE ) , BOU I LE2 ) ,CHU I LE2 ) » 

1 IUB(L), FUBIL), SIUB(L), Z(M2)»R(M?)) 


. angle 
MCL(L)= l 
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C SfEK POINTER TO BOUNDARY TABLE 

LR = L BF ( NAMEL B ( L ) ) 

I R L T =0 

ir (NItILE ) *NE . 2 ) GO TO 728 
C TRAILING edge 

L B 2 = LB+LBNEXT < LB )-9 

I L B ( L ) = (LB2-ILB+LBZ1CLB ))»/3 
FLBIL )= 1. 

CALL BARCILB2-3) 

S1LBI L ) = S IN T VL 
LB = LB2 
GO TO 757 

C LEADING EDGE OR CORNER 

75 3 I L B ( L ) = IV 
FLBIL I = 0. 

S1LBI L >=0. 

757 Z I M 1 ) = ZBT(LB) 

RIMi) = RBTILB) 

C* ADD NEW FIELD POINTS ALONG EXISTING STREAMLINES 
GIVEN- 

STA-TAB INDEX L AND LIMITS ON FIELD INDEX MLB, MOB 
COORDINATES OF FIRST AND LAST NEW PTS IN FIELD TABLE 
MARKED CHANNELS IN ORTCHN TABLE BETWEEN LR I , LR2 
STREAMLINE TABLE 
800 MS AV = MO 
C MS AV = 0 INDICATES UPSTREAM BOUNDARY 

IFINLEILE) .EQ.U MSAV = 0 
Jl = 1 

CALL JOFCHNICHNAILRl ), Jl, JX) 

CALL J0FCHN(CHNA(LR2).JX, J2 > 

C J 1 , J2 ARE SL INDEX LIMITS 

C BEGIN LOOP THROUGH CHANNELS, 2 SLS PER CHANNEL 

LRN = LRI 
MM = MI 
J SL = Jl 

805 IF ( CHNAI LRN ) .EQ. BLANK ) GO TO 835 
CALL JOFCHN (CHNA(LRN),JSL»JNXT) 

C FIND UPSTREAM FIELD PT, PUT IN DOWNSTREAM POINTER 

810 J = J SL 

IF(MSAV) 812,828,812 
812 IV =0 
815 DO 820 M=MSAV,NM 
CALL GETIX 

820 IFU.EO.JSL .AND. MD.EQ.OI GO TO 825 
IF! IV.NE.O) CALL ERROR 1 
MS A V = MO 
IV = 1 
G(J TO 815 
825 MS A V = M 
MD = MM 
CALL SAVIX 



C SAVE DATA FOR CURRENT FIELD PT 

828 M = MM 

MU = MSAV 



C fcACH ORTHOGONAL. 


639 LRPRV = LRO 
L RPRS V = 0 
M = MO 

L = LO 

LF = LFO 
T f E SO = TTE*TTE 


C* CONSIOLR MARKED CHANNELS ON LINE LR=LRPRV IN /ORTCHN/ 

C FIND INDEX OF FIRST AND LAST ACTIVE (NON-BLANK) CHANNEL 

640 LRPI = LRPRV 

LRP2 = LRPRV+LRO-3 
642 IF ( CHNAURP1 ) .NE. BLANK ) GO TO 644 
' LRPI = LRPIU 

IF (LKPi.LL.LKP2) GO TO 642 
CALL ERROR 1 

644 IF (CHNA(LRP2 ) .NE. BLANK) GO I U 646 
LRP2 = LRP2-1 
GO TO 644 

C FINC INDEX-LE OF NEXT LE-TE PT IN LRPR V-CHANNELS 

646 LE = LFO 

648 IF(NUSED(LE)-NLE(LE)-NTE(LE) ) 650,654,654 
650 LEONCE= NUSED(LE) 

I F ( NT E ( LE ) .NE .0 ) LE0NCE = 0 
LRP = LRPI 

652 IF(CHNA(LRP).EQ. BLANK) GO TO 653 

I F ( CHNA(LRP ) .EQ.CHUI LE ) .AND. LEONCE.LE.O) GO TO 660 
IF(CHNA(LRP ).EQ.CHL(LE) ) GO TO 665 

653 LRP = L RP ♦ 1 

IF( LRP.LE.LRP2) GO TO 652 

654 LE = LE ♦ 10 

IF ( LE .LC.LEE ) GO TO 648 
C NO MORF POINTS 

CALL ERR0R1 

C LL IS UPPER BOUNDARY POINT (LOWER ORTHOGONAL) 

660 LRP2 = LRP 

UPT = .TRUE. 

GO TO 670 

C LE IS LOWER BOUNDARY POINT (UPPER ORTHOGONAL) 

665 LRPI = LRP 

UPT = .FALSE. 

C MARK CHANNEL NAMES OF THE NEW ORTHOGONAL ON LINE LR 
670 CALL SETM( 1, BLANK, L EDGE ( LR ) , LRD ) 

LR I = LR + LRPI -LRPRV 

L R 2 = LR + LRP2-LRPRV 

CALL MOVE ( l , CHNA ( LRP I ) , CHNA (LR1 ) »LR2-LRl*l, 1 ) 

L RE = LR ♦LRD- 1 

C UPDATE USED LETEPT COUNT AND SET POINTERS FOR L1NE-LR 
672 NUSED( LE ) =NUSED(LE ) ♦ 1 
LRPRE V( LR )=LRPRV 
L EDGE ( L R ) = L E 
NLETh = NLE( LE )+NTE( LE ) 

IF (NLL TE-NUSLD(LE ) .FO.O) LEDGI < L R ) =-LEDGE ( LR ) 



C COUNT NUMBER OF CHANNELS, SET FIELD TABLE LIMITS 
NCHNA = 0 

00 6 7 1> LRX=LR1,LK2 

67b IM CHNA ( LRX ) .NE .BL ANK ) NCHNA a NCHNA* 1 
Ml * M 
ML B ( L ) = Ml 

M2 = M 1 + NC HN A + NCHNA- 1 
MU B ( L ) = M2 

NM = M2 
LESTA = L + 20 

C IF UPSTREAM OR DOWNSTREAM BOUNDARY, SEARCH FOR OTHER EDGE 
IF(NLE(LE).E0.1 ) CO TO 679 
IFINTtCLE I.FQ.l) GU IU 6til 
GO TO 720 
679 LX =0 
GO TO 682 

681 LX =1 

682 IF(.NOT.UPT) GO TO 690 

C FIND LOWER EDGE PT 

684 DO 686 L E 1 = LEO , L E b , 1 0 
LEX = LE1+LX 

686 IF(NLE(LEX).EU.l .AND. C HL I LE 1) .EO.CHNA ( L R l I) GO TO 680 
CALL ERROR 1 
688 LE 2 = LE 

NUSEDILEl )=NUSED(Ltl )+l 
GO TO 700 


C FIND UPPER EOGE PT 

690 DO 692 L E 2=LE 0 , LE E , 10 
LEX = LE2+LX 

692 IF(NLE(LEX>.E0.1 .AND. CHUI LE 2 > .EQ .CHNA (LR2 )) GO TO 694 
CALL ERROR 1 
694 LEI = LE 

NUSED ( LE2 ) =NUSED( LE2 1 + 1 


C* PLACE UPSTREAM OR DOWNSTREAM BOUNDARY DATA INTO STATION TABLE 
700 NAMELBIL J=BDL (LEI ) 

NAMEUB(U=BDU(LE2 ) 

IFINTEILE J.EO.ll GO TO 710 
C UPSTREAM BOUNDARY 

I L B ( L I = 1 
FLBU 1= 0. 

S 1 L B ( L ) =0 . 

LB = LBF ( NAMEUB (L 1 ) 

IUBIL )= ( LBNEXT (LB >- 9-LB Z 1 ( LB ) ) /3 
FUB(L>= 1. 

CALL BARCILB+LBNEXT (LB)— 12) 

SiUBI L >=SINTVL 


C 


GO TO 715 

DOWNSTREAM BOUNDARY 
710 LB = L BF ( NAMEL B ( L ) ) 

ILB (L ) s ( LBNEXT (LB 1-9-LBZi (LB ))/3 


FLB ( L ) = 1. 

CALL BARC(LB+LBNEXT(LB)-12) 
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LINE UP THE L.E. AND T.E. CONNECTED CHANNELS IN THE SAME COLUMN 
LRL = INDEX OF CHANNEL IN FIRST LINE (L.E. CONNECTED CHANNELS) 

LRT = INDEX OF CHANNEL IN SECOND LINE (T.E. CONNECTED CHANNELS) 

LRL = LR1 

LRT = LR3 

GO TO 588 

570 IF(LWE.LT.LRT) GO TO 578 
DO 575 LRX =LRT , LRE 

575 IF ( CHNA(LRX ) .EQ.CHNA (LRL ) ) GO TO 580 

C LRL-CHANNTL NOT INCLUDED IN SECOND LINE. PUT IN BLANK SPACE. 

CALL MOVE ( 1 , CHNA(LRM,CHNA(LRT + 1),LRT-LRE-1,1) 

578 LRE = LRE *1 

CHNA( LRT ) = BL ANK 
GO TU 586 

C LRX MATCHES LRL, PUT IN LRX-LRT BLANKS BEFORE LRL 

580 L DR = LRX-LRT 

IF(LOR) 582.586,58 2 
582 LRTO = LRL+LDR 

CALL MOVE ( 1 » CHNA(LRL) .CHNA(LRTO) .LRL-LRE-1,1) 

LRE = LRE+LDR 

LRT = LRT+LDR 

LR2 = LR2+LDR 

584 CHN A ( LRL ) =BL ANK 
LRL = L RL ♦ 1 

LRT = LRT+I 

IF(LRL.LT.LRTO) GO TO 584 

C IF NO CHANNELS UN FIRST LINE, SET FIRST VALUE TO THAT OF SECOND 

IF (LR2-LDR.LT.LR1 ) CHNA{ LR 1 ) =CHNA ( LR2+ 1 ) 

586 LRL = L RL «• 1 
LRT = L R T ♦ 1 

5 88 IF ( LRL .Lfc .LR2 ) GO TO 5 70 
IF ( LRT .GT .LRE ) GO TO 600 
LDR = LRE-LRT+1 
GO TO 582 

C DEFINE ORTCHN-TABLE INCREMENT, LRD 
600 LRD = LR2-LRO+3 

CALL M0VE(1, CHNA(LR2+1) ,CHNA(LR2+3) ,LR2-LRE,1) 

LRE = LRE+4 
LEDGE l LRO ) = I BLANK 
LRPREV(LRO)=I BLANK 
LRPRV = LRO 
LR = LRO+LRD 
LEDGE ( LR ) = IBL ANK 
LRPRE V( LR ) = I BLANK 
LR = LR+LRD 
IF(ERR) CALL ERROR 1 

C* BUILD STREAMLINE TABLt 
NJ =0 
LRL = LRO 
LRT = LRO+LRD 
X ? S AV 1 = 0. 

X2SAV 2= 0. 
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DAK LA = 0. 

C SEARCH FOR f-IRST COMMON CHANNEL 

602 L R X 1 = LRL 

L R X 2 = LRL+LRD 

NBLNK 1 = 0 
NBLNK 2= 0 

COS IF(CHNA(LRX1).E0.CHNA(LRX2I) (,0 to 610 
IF t LUNA ( LRX 1 ) .NE .BLANK ) NBLNK 1»NBLNK 14 1 
I F ( CHNA ( LRX2 ) .NE. BLANK ) NBLNK2=NBLNK24 l 
LHXl=LRXl4l 
t R X 2 = LRX2+1 

IFlLKXl.Lfr.LR2) GO TO 605 

610- DX 2- . = 8.*AMAX0(NBLNK1,NBLNK2) 

IF ( UX2.EQ.0. 1 GO TO 620 

IF (NBLNK l.NE.O) DEL 1 =DX2 /FLO A T ( NBLNK 1 ) 

IF (NBLNK2.NE.0) f) t L2 =0X2 /FLOA T { NBLNK2 I 

612 IF(CHNA(LRL).E0. BLANK) GO TO 615 
CHX = CHNA(LRL) 

X2( NJ+1 )=X2SAV1 
X 2 S AV 1 = X2SAV1 + DEL1 
X2( NJ+2)=X2SAV1 
GO TO 625 

615 CHX = CHNA(LRT) 

X2( NJ+1 )=X2SAV2 
X2S AV 2 - X2SAV2 + DEL2 
X2(NJ+2)=X2SAV2 
GO TO 625 

620 CHX * CHNA ( LRL ) 

X2INj4i)=X2INJ) 

IF(NJ.EO.O) X2(NJ41)=0. 

X2(NJ+2)=X2lNJ4i)+8. 

X2SAV1=X2(NJ42) 

X2SAV2=X2 (NJ+2) 

625 SLCHN(NJ41)=CHX 
SLCHN(NJ42)=CHX 
W( NJ+ 11=0. 

DO 630 LE 1 -LEO , LE t , 10 

630 IF ( NLE( LEI ) .NE .0 .AND. CHL (LEI ) • E O.CHX ) GO TO 632 

632 DO 635 L E2 = L EO , LEE , 10 

635 IF (NLEILE2I.NE.0 .AND. CHU ( LE2 ). t O.CHX ) GO TO 637 

637 AREA = YE ( L E 2 ) -YE ( LE 1) 

IF (AX I A) AREA=AREA*PI*(YE(LE2) + YE(LEl) ) 

FOR INLET CONE. SAVE HIGHLIGHT AREA SO EXTERNAL AREA 
MAY BE CORRECTED BY DIFF BET HIGHLIGHT AND CAPTURE AREAS. 

ARE ASV= AREA 

IF ( CHNA (LRL) .NE .BLANK ) ARE A= ARE A* DARE A 
CALL BCONV ( CHX , LT , ARE A ) 

IF (CHNA (LRL ) .NE .BLANK ) DARE A =DARE A* ARE A S V- ARE A 
LT = LT4LPSI (LT)4NPT(LD-l 
W ( N J ♦ 2 ) =XCH( L T ) 

NJ = NJ42 

LRL = LRL+l 

LRT = LRT+l 

IF ( LRL .GT.LR? ) GO TO 639 
IF(LKL-LKXl) 612*620,602 

C** BEGIN LOOP FOR BUILDING CHANNEL LIST, STATION TABLE AND FIELD DATA 

- 0 . 0 % 



equivalence 

EQUIVALENCE 

EQUIVALENCE 


(GAM, FGT, NAMEUBK, ( NR , FGP , 1 UB ) , ( NC*FGR,FUB) 

( TAB( I) ,AREATB,SLUB) , (TAB (2) ,VMB) , ( TAB ( 3 > , OHDV ) 
( TAB ( A ) , X2CL ) , ( TAB (5 ) ,VCL) * (TAB(6),MCU 


INTEGER CHNX,CHX, FIXCHN.HLE ,HTE,SOLIO 

LOGICAL UPT 


DATA SOL IO/6HSOL ID/, HLE/2HLE/, HTE/2HTE/ 


C USE INPUT SPACERS TO SET TABLE ORIGINS 


LTE 


LBOF 

LTO 

=r 

LTE + 1 

L WE 


LTb+MAXLT 

L WO 

= 

LWE + 1 

LEE 

s 

LWE+MAXLW 

LFO 


LFE + 1 

LESTA 

= 

LFE+MAXLF 

LO 


LE STA ♦ 1 


C ASSUMED INITIAL FIELD VELOCITY 

VM I N I T= .5 * SORT ( GAMA*RGA*T T A ) 

C** BUILD ORTHOGONAL-CHANNEL TABLE 

C* BUILD ORDERED LIST OF CHANNELS FROM L.E. CONNECTIONS 
C SEARCH FOR THE first LEADING EDGE PT ( NLE = 2 IN LETEPT-TABlE ) 

LR3 = LRO 

LRE = LR3-1 

LX =0 

DO 505 LE=LEU,LEE, 10 
505 IF(NLE(LE).EQ.2) GO TO 510 
C NO L.E. PTS 

GO TO 535 


C LE=FIRST EDGE PT, FIND CONNECTING CHANNELS 

510 CHN A ( LR 3 ) =CHU ( L E ) 

CHNA(LR3-H)=CHL(LE ) 

LRE = LR3 + 1 


C SEARCH FOR CHANNELS BELOW CHNA( LR3 ) 

515 DO 517 LE 3=LE0, LEE , 10 
LEX = LE3+LX 

517 IF(NLE(LEX).NE.0 .AND. C HL ( L E 3 ) .E Q .CHNA ( LR3 )) GO TO 520 
WRITE (6,1560) CHNA(LR3) 

CALL ERROR 1 


C CHECK FOR BOTTOM CHANNEL 

520 IF (CHU(LE 3) .EQ. BLANK ) GO (0 525 


C MOVE CHU(LE3) BELOW CHNA ( LR 3 ) 

CALL MOVE ( 2 , CHNA ( LR 3 ) ,C HNA ( LK3* 1 ) , L R3-LRE- l , 1 , 
1 CHUILE3) ,CHNA(LK3) , 1,1) 

LRE = LRE + 1 
GO TO 515 

C SEARCH FOR CHANNELS ABOVE CHNA(LRE) 

525 DO 530 LE A=LEO, LEE ,10 
LEX = LEA+LX 






5 10 IMNLE(LEX) .Nfc.O .AND. CHU( LE4 ) .EO.CHNA C LRE ) ) GO TO 532 
WRITE (6,1560) CHNA(LRE) 

CALL ERR0R1 

C CHECK FOR TOP CHANNEL 

532 1F(CHL(LE4).EQ. BLANK) GO TO 535 

C MOVE CHHLE4) ABOVE CHNA(LRE) 

L RE = L RE ♦ 1 
CHNA( LRE)=CHL ( L E <* ) 

GO TO 525 

C REPEAT THE ABOVE FOR THE TRAILING EDGE 

535 IF(LX.EC.l) GO TO 545 
LRl = L R 3 

LR2 = LRE 

LEI = L E 3 

L E 2 = L E 4 

LR3 = LR2+1 

LX = 1 

C LX * 1 TO PICK UP NTE(LEi) RATHER THAN NLEILE3) 

C SEARCH FOR THE LAST T.E. PT 

LE = LEE-9 

540 I F ( NT E ( L E ) • EO ■ 2 ) GO TO 510 
LE = LE- 10 

I F ( LE .GE.LEO) GO TO 540 

C NO L.E. OR T.E. PTS 

545 IF(LRE-LRl) 547,555,555 

547 LE * LEO 

IF(CHL(LE).NE. BLANK) GO TO 550 

1F(CHU(LE ).NE. BLANK) GO TO 552 

CALL ERROR 1 

550 CHNA( LRl)-CHL(LE) 

GO TO 554 

552 CHN A ( L R 1 ) =CHU ( L E ) 

554 LR2 = LRl 

LR3 * L R 2 ♦ 1 

CHNA(LR3)=CHNA(LR1) 

LRE * LR 3 

C CHECK FOR EXTRA CHANNELS IN LETEP-TABLE 

555 LE = LEO 

556 IF(CHL(LE ).E0. BLANK) GO TO 558 

CHX = CHL(LE) 

LX =0 

GO TO 560 

55B IF(CHU(LE).EO. BLANK) GO TO 564 
CHX = CHU(LE) 

LX = l 

560 DO 561 LR=LR1,LRC 

561 IF( CHNA(LR) .EG. CHX ) GO TO 562 

ERR = .TRUE. 

WRITE (6,1560) CHX 

562 IE(LX) 564,558,564 

564 LE = L E ♦ 1 0 

IF(LE.LT.LEE) GO TO 556 




C LRD = NUMBER OF CHANNELS PLUS ONE * LR INDEX INCREMENT 

C LEDGE = INDEX OF THE ORTHOGONAL POINT IN THE LETEPT-TABLE 

C LRPRE V= POINTER OF LINE OF UPSTREAM CHANNELS IN ORTCHN-TABLE 

C CHNA = CHANNEL NAMES 

COMMON /ORTCHN/ L E DGE (1) , LRPREV (1 ) ,CHNA ( <,79 ) 

INTEGER CHNA 
DIMENSION JCHNA(l) 

EQUIVALENCE ( JCHNA »C HNA } 

C STREAMLINE TABLE 

COMMON /SLTAB / W ( 12 8 ) » X 2 ( I 2 8 ) , SLCHN ( 1 2 8 ) 

INTEGER SLCHN 

COMMON /CBITS / BITS, BLANK 
EQUIVALENCE ( I BLANK, BLANK ) 

INTEGER BLANK 

COMMON /CPI / PI ,TWOPI , P I Q2 , P I Q<, , TODEG , T ORAD 
COMMON /CTABPR/ 1 1 TAB 

COMMON /ERASE / X X ( 1 ) , YY , ANGG ,NL ♦ NT , CNL »CNU , BNL » BNU * NZERO 
COMMON /SPACER/ M A XL H , MA XL T , MAXLF , MA XLW 
COMMUN / T ROUBL / E R K , ERRM A J , I NERR , PRE RR 
LOGICAL ERR.ERRMAJ, INERR,PRERR 


C 

C 


c 

c 

c 

c 

c 

c 

c 

c 

c 

c 


c 

c 

c 

c 

c 

c 

c 

c 

c 


CHANNEL 

INDEX- 

COMMON 

1 

2 

A 


INPUT DATA TABLE 
LH = L HU , L HL 
/CHDATA/ CHNAM ( 


LOGICAL 
INTEGER CHNAM 
DIMENSION 
REAL 

EQUIVALENCE 
BOUNDARY TABLE 
INDEX- LB=LBDO,LHDE 
LBNEX T= INCREMENT TO 
INCREMENT TO 
CHANNEL WITH 


I) »LHNEXTU),WTFLOW(l) , TTO U ) , PTOU > , 
TSOI 1),P SOU) .MACHO (i) ,AO(ll , VAR YU) , 
RGU).GAM(l), NRU) ,NCU) * TAB (61 , 

BB (75) 

VARY 


VO(l) 

MACHO 
( VO, MACHO) 


NEXT BOUNDARY 

LB/ I = INCREMENT TO THE FIRST BOUNDARY POINT (=0 BEFORE COALLATIO 
CHN AM E = CHANNEL WITH WHICH THE BOUNDARY DATA IS ASSOCIATED 
UP = T OR F FOR UPPER OR LOWER BOUNDARY 

LEDEx = RELATIVE INDEX OF L.E. POINT WHEN LOWER AND UPPER SURFACE 
CONTOURS ARE CONNECTED 

BDNAMh,LBA,LBB=NAME AND INDEX LIMITS OF SPECIFIC BOUNDARY 

DATA WHEN BOUNDARIES ARE COALLATED 
DIMENSION BUT! 1 ) , LBNEX T (1 ), LBZK 1) * 

1 CHNAME U ) ,UP(1) fLEDEX(l) , 

2 ZBT( I ) ,RBT( I ) ,ANGBT(<»2) 

LOGICAL UP 

INTEGER BDT, CHNAME, BDNAME 

DIMENSION BDNAME ( I ) ,LB A (I ) , LBB U ) 

EQUIVALENCE (BDNAME, ZBT) , (LBA.RBT), 

TABLE OF CONVECTED PROPERTIES 
INDEX- LT=LTO,LTE 
CH =• CHANNELNAME 

LTNEX T= INDEX INCREMENT TO THE NEXT CHANNEL 
LPSI = RELATIVE LOCATION OF PS I LIST 

NPT = NO. OF PSI, TT, PT AND RCU VALUES 

LTT = RELATIVE LOCATION OF TT LIST 

LPT = RCLATIVE LOCATION OF PT LIST 

LRCU = RELATIVE LOCATION OF RCU LIST 


( LBB, ANGBT ) 


nr 


,n\ 
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1 

2 

i 


DIMENSION cm 1» ,LTNEXT(1> ,NPT( 1) ,LPSI (1) *LTT(1 ) ,LPT ( 1 ) , 

LRCU(l), 

CKG( 1),CPGJ( L ) » C2C P (1 ) »QGAM(1 ) ,FGTd ) *FGP( 1), 

F GR ( 1 ) » AREATB (485 ) 

DIMENSION XCH(l) 

EQUIVALENCE <CH,XCH) 

C TABLE UF WAKE DISPLACEMENT THICKNESS 
C INDEX- LW=LWO,LWb 

DIMENSION X2Wd ) ,LWNEXTd) ,SlW<A7) 

DIMENSION DST(l) 

EQUIVALENCE (DSTfSIW) 

subtable arrangement is- 

X2W, LWNEXT(=2+2N) ♦ S1W(1),SLW(2)...S1W(N), DST(l) ,DST ( 2 ) . . .DST ( N) 
X2W = STREAMLINE COORD INATL 
SIW = DISTANCE ALONG STREAMLINE FROM T.E:. 

DST * WAKE DISPLACEMENT THICKNESS AS A FUNCTION OF SlW 
FLOW ADJUSTMENT TABLE 
INDEX- LF=LFO,LFE 
NFCOL S= 8 

X1F = ORTHOGONAL COORDINATE 

X2F = STREAMLINE COORDINATE OF SL EMINATING FROM T.E. 

X LBF = X I- COORD I NATE OF CHOKE STATION OF FLOW BELOW T.E. 

X1AF = X 1- COORD I NATE OF CHOKE STATION OF FLOW ABOVE T.E. 

S IF = SI-COORDINATE OF T.E. {UPPER SURFACE). THIS ITEM 

IS USED WHEN INTERPOLATING FOR WAKE DELTA-STAR. 
LFB,LFA=INDICES OF STATIONS BELOW AND ABOVE T.E. 

NCHB»NCHA=N UMBER OF CHANNELS BELOW AND ABOVE T.E. 

LRF = INDEX OF DUMMY ORTCHN LIST FOR THE T.E. 

LRXF = INDEX OF LAST CHANNEL BELOW THE T.E. 

JORDE R- 0 IF TOTAL FLOW AT XiF IS GIVEN 
= 2 IF FLOW ABOVE T.E. IS GIVEN 
= I IF FLOW BELOW T.E. IS GIVEN 
JORDER= -1 IF FLOW AT XIF IS CHOKED AND SINGLE CHANNEL 
DIMENSION XIF( l),X2Fm ,XlBFin,XlAF(i) , 

I S 1 F ( 1 ) » NCHB ( l ) » NCH A ( 1) fJORDER(l) , VNR { 12) 

EQUIVALENCE ( LFB , X1BF I * ( LFA ,X1AF ) , (LRF, NCHB) , ( LRXF , NCHA ) 

DIMENSION LFB( 1 ) «LFA( 1 ) »LRF ( 1 ) »LRXF ( 1 ) 

STATION TABLE 
INDEX- L=LO,LESTA 

SCHOK E = STATION CHOKE INDICATOR ( ADJWF ,BRHS ,WRIOUT ) 

MCL = SHARP CORNER INDICATOR (BLDTBS) 

MCL = FIELD INDEX OF CONTROL STREAMLINE ( PT MOVE ♦ FLOBAL ) 

DIMENSION XI(l),LNEXT(i), MLB ( I ) ♦ MUB (i)»PRIM(I) , 

I TYPELBU ) ,NAMELB ( 1)»ILB(1)*FLB(1),S1LB( 1), 

1 TYPEUB(1 ) yNAMEUBI 1 )» I U8 ( 1 ) , FUB d ) , SI UB ( 1 ) , 

3 VMB( l)«OWOV1 I), X2CLd),VCLd),MCL(48I) 

LOGICAL PRIM 

INTEGER TYPELB » T YPEUB 
DIMENSION SCHOKE(l) 

EQUIVALENCE ( SCHOKE , DWDV ) 

EQUIVALENCE ( C HNAM , BD T ,CH , X2 W , X IF ,X1) 

EQUIVALENCE ( L HNE XT , L BNE X T , L TNE XT ,L WNE XT , X2F , LNE XT ) 

EQUIVALENCE ( W T FLOW , L B ZI , NPT , S 1 W , XiBF , MLB ) 

EQUIVALENCE ( T TO , CHNAME ♦ L PSI , XI AF , MUB ) , ( PTO, UP, L T T , S I F , PR IM ) 

EQU I VALENCE (TSO»LEDEX»LPT ,NCHB * TYPELB) 

EQUIVALENCE ( P SO,V H T , L RCU , NCHA , NAMELB ) 

EQUIVALENCE ( MACHO, RBT ,CRG , JORDE R , I LB ) , ( AO , ANGBT , CPG J , VNR , FLB ) 

EQUIVALENCE ( VARY ,C2CP ,S1LB) , ( RG »QGAM, TYPEUB ) 

3-V3" 



IF ( GAMMA. NE .0. ) A T I NF = SQR T I G AMMA*CRG ( LT ) *T T I NSL ) ) 

MINF = MACHC 

UINF = MACHC*SQRT(GAMMA*CRG(LT)*TSC) 

990 L T A = LT 
RETURN 

1185 FORMAT ( /1X20H*** ERROR- FOR CHN=A6 , 1 X53HTHE STATIC PRESSURE EXCEE 
*DS THE INPUT TOTAL PRESSURE. # 8H { BCONV) ) 

1182 FORMAT! TAH **♦ l RROR- THt R IOR YI FOR CHN- *A6, 

*35H MUST Ht IN ASCENDING ORDER (BCONV) I 

1183 FORMA f ( 2 1 H *♦* ERROR- FOR CHN= »A6,31H THE INPUT FLOW RATE OF 
*WTFLOW=,F9.3,37H IS GREATER THAN THE CHOKED VALUE OF »F8.3, 

*8H ( BCONV ) ) 

118A FORMAT ( 53H *** ERROR- FAILURE OF PS-ITERATION GIVEN WTFLOW/CG=t 
*F 9 • A » 9H FOR CHN= ,A6,8H (BCONV) ) 

1200 FORMAT I / IX 32HERROR- THE FLOW RATE FOR CHANNEL2X, A6, 1X15HIS NOT DBF 
♦INED.) 
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-BLDTBS- 


♦UCCK HLOTBS 

SUBROUTINE B L D T B S 

*HL»ruS BUILD OP. T H0G0NA L /CHANNEL TABLE, 

STREAMLINE TABLE, STATION TABLE, 

FIELD TABLES AND FLOW ADJUSTMENT TABLE. 

input- 

boundary TABLE, /8DYTA8/ 
channel input date, /chdata/ 

ORDERED EDGE POINTS, /LE TEPT/ 

OUTPUT- 

LIST of channels for each orthogonal, /ortchn/ 

TABLE OF CONVECTLD PROPERTIES, /CONVTB/ 

STREAMLINE TABLE, /SL TAB / 

STATION TABLE, /STATAB/ 

FIELD VALUES, /Cl/, /CR/, /CS2/, /CM/ 

table of stas at which flow adjustment must be accomplished, /cadj 

TRAILING EDGE WAkE DISPLACEMENT THICKNESS TABLE, IF NOT CARO INPUT 

COMMON /ALLCOM/ M ACHA , P S A , T SA , P TA , TT A, AXI A ,RGA, GAMA , 

1 -MACHC,PSC ,TSC,PTC ,TTC, AXI C ,RGC, GAMC, 

2 DAXlT,SCALEA,TT£,CHOTST 

REAL M ACHA ( II , MACHC 

LOGICAL AXIA ,AXIC ,CHOTST 

COMMON /CBEAM2/ DR ,DZ , YP A , YPB ,F , G , D X, YQDX , ZM , RM , ANGM ,CURVM, SIM, 

1 RZONLY, ANGCHD,SINTVL, YPASO, YPAB , YPBSO 

LOGICAL RZONLY 

INDEX- M=MO,NM 
COMMON /CVM / VM(30 0) 

COMMON /Cl / H 300 ) 

COMMON /CR / R ( 300) 

COMMON /CS2 / S2T300) 

COMMON /CS1 / S 1 ( 300 ) 

COMMON /CPHIi / P H 1 1 ( 300 ) 

COMMON /CM / JMS ( 300 ) 

COMMON /CCURV / CURV I 300 ) 

COMMON /CB / b ( 300 ) 

COMMON /CIDEX / M , J , MU , MD , I S T AG 
DIMENSION WSU 300) 

EQUIVALENCE <WSL,CURV) 

COMMON /IXORIG/ LHO.LHE, LBDO ,L BDE , LTO, LTE , LWO,LWE, LFO, LFE , 

* LO,LE STA , LDUM ( 8 ) , 

* MO ,NM , N J »NFCOLS» MA XN J , MAXOL , MA XNM , MAXLE , 

* LEO, LEE, LRO, LRE , LRD 

DIMENSION LIMITS C 2 A > 

EQUIVALENCE (LIMITS, LHO) 

table of leading edge and trailing edge points 

INDEX- LE =LEO »L EC , 10 

NL E , N TE =N0 . OF L.E. AND T.E. COINCIDENT PTS, RESPECTIVELY 
CHL , C HU =NAME OF CHANNEL ABOVE AND BELOW PT , RESPECTIVELY 
BDL ,BUU=B0UNDARY NAMES ASSOCIATED WITH THE POINTS 

NUSED = COUNT OF TIMES THAT POINT USED IN CONSTRUCTION OF /ORTCHN/ 
COMMON /LETEPT/ XE ( l ) , YE ( 1 ) , ANGE ( i ) • NLE ( 1 ) ,NTE ( 1 ) , 
l CHL( I) tCHUm »BDL ( 1) ,BDU(I) , NUSED (<,91) 

INTEGER CHL,CHU,BDL,BDU 

table of channels embraced by each orthogonal 
index- LR=LRO,LRE ,lrd a 



IF( AX IA ) GO TO 170 
00 165 J=1,NSL 
165 A( J ) = Y{ J ) 

GO TO 173 
170 00 172 J = 1 » N SL 

172 A< J) = P I *R ( J ) *R ( J ) 

173 PTMIN = P T ( 1 ) 

DO 174 J = 2 * NSL 

PTMIN = AM INI (PTM I N# PT (J ) ) 

174 IF( A( JI.LT.AI J-IJ) ERR = . TRUfc * 

I F l ERR ) GO TO 182 

175 OV = 0. 

176 IF(PS.EO.HITS) GO TO 177 
YTOL = 1.E6 

GO TO 179 

177 PS ( 1 ) = . 95*P TM IN 
YTOL = WTF* 1 .E-5 

178 CALL SETM(1,PS. PS(2),NSL-1) 

179 DO 180 J * 1 * N SL 

TS = TTI J)*(PS( JI/PTI J))**FGT(LT) 

IF(TS.GE.TTIJ)) GO TIJ 185 

V(J) = SQRT(C2CP(LT)*(TT(J)-TS))*PS(J)/(CRG(LT)*TS) 

180 CONTINUE 
PSI ( 1 1= 0. 

CALL L SPF I T ( A , V , N SL , A, PSI. NSL* -1) 

DELP = PTM IN-PS ( 1 ) 

XJP = . 5*DELP 

DYDX = -,5*PSI (NSL) /DELP 

YO = WTF 

CALL QIREMIPS.PSI (NSL) ,XJP,QV) 

I F ( QV . GE . 2 . .AND. OV(5).EQ.O.) GO TO 183 
IFICV.E0.2l.) GO TO 184 
1FIQV.NE.0.) GO TO 178 

C *M AC HC AND TSC FUR FAR FIELD CALCULATION (RARE OPTION) 

MACHC = V ( N S L ) /SORT (GAMMA*CRG(LT)*TS) 

TSC = TS 
GO TO 250 

C ERROR COMMENTS 

182 WRITE (6,1182) CHT 
GO TO 187 

183 PSI MAX= PSI (NSL )*CG 

WRITE (6,1183) CHT ,WTFLOW(LH) , PSI MAX 
GO TO 186 

184 WRITE (6,1184) WTF, CHT 

GO TO 186 / 

185 WRITE (6,1185) CHT 

186 CALL TABPRT( 2HQV,UV, 8, 8) 

CALL TABPRT ( 6HC0 I RE M , YT OL , 4 , 4 ) 

CALL TABPRT( 3HPSI , PSI, NSL, 10) 

187 ERR = .TRUE. 

CALL TABPRT( 2HPS,PS,NSL» 10) 

CALL TABPRTl 2HPT,PT,NSL, 10) 

CALL TABPRT( 2HTT,TT,NSL, 10) 

CALL TABPRT(4HAREA,A,NSL, 10) 

GO TO 250 



C UVtN MAC H NUMBER, AREA AND STATIC FLOW PROPERTIES 

190 IF! WTF.NE.O. .AND. (LH.EO.O .OR. M ACHO ( LH ) . E Q . B ! T S ) ) GO TO 200 
MACHC = MACHA 
IF(LH.EO.O) GO TO 195 

I F ( MACHO ( LH) .NE.B I TS 1 MACHC=MACHO( LH ) 

IFIPSU(LH).NE.BITS) PSC=PSO(LH> 

I F ( TSO(LH).NE.BITS) TSC=TSO(LH) 

195 IF( CGAMILT ) .EQ.O. ) F G 1 = 1 . / ( T SC*CRG I L T )) 

TTQTS = 1.*0.5*FGI*MAChC»MACHC 

196 IFILH.EO.O .OR. ( TTO I LH ) . E 0 . B I T S .AND. PTO ( LH ) . E Q. B I TS )) GOTO 197 

C *TOTAL CONDITIONS ARE SPECIFIED RATHER THAN STATIC 

T SC = TT/TTOTS 

PSC * PT/TTOTS**FGP(LT 1 

GO TO 198 

197 TT * T SC*T TOTS 

PT = PSC*TTQTS**FGP(LT 1 

198 IF( WTF.NE.O.) GO TO 240 

IF ( LH.NE. 0 .AND. AO ( L H ) .NE . B I T S ) AREA=AO( LH) *RHL 

IF ( LH.NE. 0 .AND. AQ ( LH ) «NE . BITS .AND. AXIA ) AREA=AO( LH ) *P I 

* *RHL**2 
AREATBI LT »=AREA 

WTF = PSC/(CRG(LT)*TSC )* ARE A* MACHC 
I F ( CGAMILT ) .NE.O. ) WTF =W TF* SQRT < GAMMA*CRG ( L T ) *TSC ) 

GO TO 240 

1 

C GIVEN FLOW RATE ♦ TOTAL/STATIC CONDITIONS FROM STC/SHEET-1 

200 AREATBILT )=0. 

IF( TSC.LT.TTC) 

♦AREATBILT )=WTF*CKG(LT»*TSC/IPSC*SQRT(C2CP(LT) MTTC-TSC) ) ) 

210 AREA = AREATBILT) 

240 PS I ( NSL ) = WTF 

IFI WTF.NE.O. ) GO TO 250 
ERR = .TRUE. 

WRITE (6,1200) CHT 

C PUT DATA IN CONVTB- ARRAY 
250 CHILT )= CHT 
NPT ( l T ) =NSL 
LTl = LT+15 

CALL MOVE I 1 » PSI ,CH( LTl ) ,NSL t l) 

LPSI(LT)=LT1-LT 
LTl » LT1+NSL 

CALL MOVE ( 1 , TT,CH(LTl),NSL, I) 

LTTILT )=LTi-LT 
LTl 3 LT1+NSL 

CALL MOVE ( 1 , PT,CHILT1),NSL, 1) 

LPT (LT )=LTl-l T 
LTl =LT 1+NSL 

CALL MOVE I 1 , RCU.CHILTI) ,NSL, 1) 

LRCUI LT )=LTl-LT 
LTNEXT (LT ) = 15*4*NSL 
LTE = LT+LTNEXTILT )-l 

C EXTERNAL CHANNEL PROPERTIES FOR FAR FIELD CALC 
I F ( CHT .NE .EXT ) GO TO 990 
ATINP = 1.E6 

? ito 


EQUIVALENCE 
EQUIVALENCE 
EQUIVALENCE 
EQUIVALENCE 
EQUIVALENCE 
COMMON /IXOR 

* 

* 

# 

DIMENSION 

EQUIVALENCE 


( MACHO, RBT.CRG, JORDER, I LB) , ( AO , ANGST » CPGJ * VNR, FLB ) 
(VARY,C2CP,S1LB) . ( RG ,QGAM* TYPEUB ) 

( GAM , FGT * NAME UB ) , (NR ,FGP, IUB) » ( NC*FGR»FUB ) 

(TAB( 1),AREATB,SIUB), ( TAB ( 2 I • VMB ) » ( T AB ( 3 ) * DWDV ) 
(TABU) ,X2CLI , (TAB(5)»VCL), (TAB(6)»MCU 
G/ LHO,LHE, LBDO.LBDE, LTO,LTE, LHO*LWE, LFO.LFE, 
LO.LESTA, LDUM ( 8 ) » 

MO,NM, NJ,NFCOLS, MA XN J , MAXOL .MAXNM, MAXLE , 

LEO, LEE, LRO , LRE , LRU 
L I M I T S ( 2 4 > 

(LIMITS, L HO) 


COMMON /CBITS / BITS, BLANK 

COMMON /CFRFIN/ A T INF , MI NF , R FFR EF , U1 NF , ZDN1 , ZDN2 5 
REAL MINE 

COMMON /CGRAV / CG 
COMMON / CNORM / RHL ,RM, AHL , ARM 
COMMON /CPI / PI ,TWOPI , PI Q2 , P I Q4 , TODEG , T ORAD 
COMMON /CQ I REM/ Y TOL , YO , D YDX , CT RMAX 


l 


COMMON /CTAPOS/ 
LOGICAL 

COMMON /ERASE/ 

DIMENSION 
EQUIVALENCE 
COMMON /TROUBL / 
LOGICAL 


RESTRT ,ENDBOf ,ENDFIL,K6SV 
RESTRT,ENDBOT,£NDFIL 
EDUM( 72) ,QV(8)» A(90)«V(90)« 
PSI(90),R(90),TT(90) ,PT(90) ,RCU(90) ,PS(90) 
Y( 90) 

( Y,R) 

ERR,ERRMAJ,INERR,PRERR 
ERR,ERRMAJ»I NERR » PRERR 


INTEGER 


CHT,EXT 


DATA EXT/3HEXT/ 


CHT = CHTA 

CALL SETMl I, BITS, PSI,540) 
CALL RTCF I (CHT.LH ) 


C DEFINE GAS PROPERTIES 
LT = LTE+1 

LTE = LTE+I5 

QGAM ( L T )=0. 

FGR ( L T ) =0. 

FGP ( L T ) = l . 

FGT ( L T ) = I . 

GAMMA = GAMA 

IF(LH.NE.O .AND. GAM ( LH ) . NE . B I T S ) GAMMA=GAM ( LH ) 

I F ( GAMMA. EQ.O. ) GO TO 85 
FG1 = GAMMA-I. 

FGR(LT)=1./FG1 

FGP ( L T )=GAMMA*FGR( LT ) 

FGT (LT )=FG1/GAMMA 
QGAM( LT |*1. /GAMMA 

85 CRG ( L T ) =RGA 

IFtLH.NE.O .AND. KG( LH ) . NL .B I TS ) CRG ( LT ) =RG ( LH) 
CPGJt LT ) = FGP( LT )*CRG(LT) 

C2CP(LT)=2.*CPGJ(LT) 

C DEFINE TOTAL PROPERTIES AS DETERMINED FROM DATA ON 




c MC/'jHm-i uf rjPui 

r r r. = u a 

PTC = PTA 

PSC = PSA 

IF ( GAMA. 60. 0. ) GO TO 95 
F 02 = GAMA-1. 

rGRA = GAMA/FG2 
GO TO 97 

95 FG2 = l./(TSA*RGA) 

FGRA = 1. 

97 IF( MACHA.EQ.BITS) GO TO 99 
TTOTS = 1 .♦ .5*FG2*MACHA*MACHA 
TTC = TSA*TTQTS 

PTC = psa*ttots**fgra 

T SC = TSA 

GO TO 100 

99 T SC = TTC*(PSC/PTC)**( i./FGRA) 

TTQTS = TTC/TSC 

MACHC = SQRTt 2.*( TTqTS-1 . )/FG2) 

C NUMBER OF INPUT STREAMLINES. GIVEN FLOW RATE. 
100 NSL = 1 

WTF =0. 

IF(LH.EO.O) GO TO 150 
NSL = NR(LH) 

I F C WTFLOW(LH) .NE.BITS) W T F*W T FLOW l LH ) /CG 

C NO INPUT PROFILES 

IF(NSL.NE.O) GO TO 150 
TT = TTC 

PT = PTC 

I F I TTO(LH). NE.BITS) TT =*T TQ(LH ) 

IF( PTO(LH). NE.BITS) PT=PTO(LH) 

NSL = 1 

C FILL PS, PT, TT AND RCU TABLES 
150 I F ( TT.EQ.BITS ) TT» TTC 
IFTPT.EO.BITS) PT^PTC 
I F < RCU. EQ. BITS) RCU=0. 

1 F ( PSI .EQ.BITS) GO TO 160 
CALL F ILL (PSI ,PT, l ,NSL) 

CALL F ILL (PSI ,TT, i,NSL ) 

CALL F ILL (PSI , RCU, 1, NSL) 

I F I WTF.EO.O. ) GO TO 250 
CONST = WTF/PSI (NSL) 

DO 155 J= l , NSL 
155 PSI ( J )= CONST *PS I ( J) 

GO TO 250 

160 IF ( R. EQ.BITS) GO TO 190 
CALL FILL(R,PT, i.NSL ) 

CALL F ILL (R,TT, l, NSL ) 

CALL FILL(R,RCU,1,NSL) 

IF( PS. NE.BITS ) CALL F I LL C R, PS , 1 ,NSL ) 

C INTEGRATION OF RHO*V*0A 
IF(NSL.EQ.l) GO TO 190 

IF( PS. EQ.BITS .AND. WTF.EO.O.) CALL ERROR l 

2 iff 



o r> 


♦DECK BUILDS 

PROGRAM BUILDS 

COMMON /IXORIG/ LHO, LHE, LBDO »LBDE » LTOtLTE » LWO »LWE , LFO.LFE 

♦ LOtLESTA , LDUM ( 8 ) » 

♦ MO,NM, N J »NFCOL S » MAXNJ ,MAXOL,MAXNM,MAXLE, 

♦ LEO, LEE, LRO,LRE,LRD 

DIMENSION LIMITSI24) 

EQUIVALENCE (LIMITS, LHO) 

FLOW ADJUSTMENT TABLE 
INDEX- LF=LFU,LFE 

COMMON /CHDATA/ X IF ( 1 ) , X 2F ( 1 ) , X 1BF (1) , XI AF (1) , 

I S 1F( 1) ,NCHB(1),NCHA( L),JORDER(l) « VNR ( 12 ) 

EQUIVALENCE ( L FB » X 1BF ) , ( LFA ,XiAF ) , ( LRF ,NCHB) , I LRXF, NCHA ) 
DIMENSION LFB( 1 ) » L F A ( 1 ) ,L RF ( 1 ) , LRXF (II 

DIMENSION TABLES ( 10) 

EQUIVALENCE ( TABLES t 1 1 • X IF ( 1 ) ) 

COMMON /CLWOSV/ LWOSV 


COMMON /SELECT/ LENTRY 

GO TU (5,10), LENTRY 
5 CALL BLDTBS 
GO TO 20 

C REBUILD CONVECTED PROPERTIES TABLE AND REPACK IF RESTRT*T. 
10 CALL RBCONV 

NMOVE 1 = LTE-LBDO+1 
LWTO = LHE ♦ 1+NMOVE 1 

CALL MOVE ( 2 , TABLES(LBDO),TABLES(LHE+l)»NMOVEl,l, 
l 

MOV E 1 = 

LBDO = 

LBDE = 

LTO 
LTE 
LWO 

MOVE 2 = 

LWE 
L F 0 
LFE 
LO 

LESTA = 

C SET FLOW 
LF 

850 IF (LF.GF.LFF ) GO TU 20 
VNR ( L F ) = 0. 

LF = LF+NFCOLS 
GO TO 850 


TABLE S( LWO) , TABLES ( LWTO ) ,LESTA-LWOSV+l , 1 ) 
L HE ♦ 1 -L BOO 
L BDO + MOVE 1 
LBDE+MOVb 1 
LT0+M0VE1 
LTE+M0VE1 
LWTO 

LWO-LWOSV 
LWE+M0VE2 
LF0+M0VE2 
LFE ♦M0VE2 
L O+MOVE 2 
LEST A+M0VE2 

ADJUSTMENT ITERATION COUNTER TO ZERO 
LFO 



20 RETURN 
END 
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♦DECK BCONV 

SUBROUTINE BCGN V I C HT A , L T A , ARE A ) 

* BC ON V - BUILD CONVECTED PROPERTIES TABLE 

INTEGER C HT A 


-BCONV- 


INPUT- 

CHTA = CHANNEL NAME 

AREA = FLOW AREA IN CASE NO /CHDATA/ IS AVAILABLE 
DATA IN THE CHANNEL DATA TABLE, /CHDATA/ 

OUTPUT - 

L T A = INDEX OF CHTA IN CONVTB 
SUBTABLE OF CONVECTED FLOW PROPERTIES 
DETERMINATION OF CHANNEL PLOW RATE 

OUTPUT FOR FAR FIELD CALCULATION 
ATINF = SPEED OF SOUND AT STAGNATION TEMPERATURE 
MINF = FREE STREAM MACH NUMBER 
UINF = FREE STREAM VELOCITY 


COMMON /ALLCOM/ M ACHA , PS A , TS A ,P TA , T T A , AXI A ,RGA, GAMA , 

1 MACHC ,PSC,TSCtPTC*TTC, AX l C ,RGC » G AMC , 

2 DAXlT,SCALEA,TTE,CHOTST 

REAL MACHAI I) , MACHC 

LOGICAL AXIA,AX1C,ChOTST 

CHANNEL INPUT DATA TABLE 
INDEX- LH=LHO » LHE 
TABLE OF CONVECTED PROPERTIES 
INDEX- LT-LTOtLTE 

CH = channelname 
L TNEX T= INDEX INCREMENT TO 
L PS I * RELAT IVE LOCAT 
NPT * NO. OF PSI. TT 
LTT = RELATIVE LOCAT 
LPT = RELATIVE LOCAT 
LRCU = RELATIVE LOCAT 
COMMON /CHDATA/ CHNAM< 


the next channel 


1 

2 

4 


ION 

OF 

PS! LIST 




f P 

T AND RCU VALUES 



ION 

OF 

TT LIST 




ION 

OF 

PT LIST 




ION 

OF 

RCU LIST 




l) « 

lhne 

XT 111 » WTF 

LOW! 

I) 

, TTO I 1 ) ,PTO( 1 ) , 

,PSO(l> 

, MACHO! 1) 

, AO ( 

1 ) 

, VARY! 1 ) , 

GAM 

III* 

NR 1 1 ) , NC 

II) . 

TAB (6) , 


logical 
integer chnam 
dimension 

REAL 

equivalence 

DIMENSION 


1 

2 
3 


BB ( 75 I 
VARY 

VO( 1 ) 

MACHO 
( VO, MACHO) 

CHI I ) ,LTNEXT m ,NPT ( 1 ) ,LPSI (l ) ,LTT( 1 ) ,LPT m , 
LRCU ( 1 ), 

CRGI I ) ,CPGJ I 1 ) ,C2CP( 1) ,QGAM( l ) , FGT ( 1 ) , FGP ( 1 ) , 
FGRI 1),AREATB(A85» 


INTEGER CH 
DIMENS ION XCHI I ) 
EQUIVALENCE <CH,XCH) 


EQUIVALENCE 
EQUIVALENCE 
l QU 1 V Al t NCE 
F.QUI VALFNCE 
EQUI VALENCE 
EQUIVALENCE 


( CHNAM ,BDT »CH»X2W»XiF ,X1) 
ILHNEXT,LBNEXT,LTNEXT,LWNEXT,X2F,LNEXT) 

( WTFLOW.LBZI.NPT ,S1W,X1BF , MLB ) 

( T TO.CHNAML ,LPSI ,X|AF ,MUB) , ( P TO, UP, L T T , S I F , PR I M ) 

(TSO*LEDEX,LPI ,NCHB,TYPELB) 

IPSO, ZBT, LRCU,NCHA , NAMELB ) 
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X2W,LWNEXT(=2 + 2N) , S1W( 1) , S 1 W( 2 ) . . . S1W (N) , OSTU ) *OST (2 ) # . .DST IN) 
X2W = STREAMLINE COORDINATE 

SlW = DISTANCE ALONG STREAMLINE FROM T.E. 

DST = WAKE DISPLACEMENT THICKNESS AS A FUNCTION OF SiW 
EQUIVALENCE ( CH, X IF , X 2W I , ( LTNEXT, X2F , LWNEXT ) , (NPT »XIBF ,SIW) 

EQUIVALENCE <LPSI#X1AF), (LTT,S1F), I LPT « NCHB) « (LRCU.NCHA) 
EQUIVALENCE (CRG, JORDER) , (CPGJ.VNR) 


COMMON /C I DE X / 
COMMON /CMAXI1/ 
COMMON /CPTMOV/ 
COMMON /CR / 
COMMON /CSi / 
COMMON /CTHICK/ 
COMMON /CZ / 
COMMON /ERASE / 


M , J , MU , MO • I S T AG 
MAXI T,MAJCTR, GREF IN, EDUM 
VELPOT ylCOBf NODENS » CPTDUM 
R( 300) 

SI 1300) 

NTHKX»NTHKY,THKXI20) » THKY ( 20) ,THIK2D178) 
Z( 300) 

PSI(BOO) 


INTEGER CHX 


INTERPOLATE FOR LAMINA THICKNESS 
NK = MB-MA+1 

CALL SETM(1,I., L AM, NK ) 

IF(NTHKX.LE.l) GO TO 100 
CALL LFIT2D(Z(MA) ,R(MA),LAM,NK) 

INITIALIZE 
100 WAKE = .FALSE. 

DEFINE NUMBER OF STREAMLINES# NK, ASSOCIATED WITH EACH CHANNEL 
K = 1 

M = MA 

WAOC = 0. 

105 NK =0 

K I = K 

Ml = M 

HO CALL GETIX 

IF(M.NE.Ml) GO TO 114 
CHX = SLCHN(J) 

PSI 1 * X2(J) 

114 IF ( SLCHNt J ) .NE.CHX ) GO TO 120 
NK = NK*1 

DISP1 K )=0. 

WST A( K ) =W ( J ) +WADD 
PSI (NK )=X2( J) 

K = K*i 

M = M+i 

if(m.le.mb) go to no 

FIND INDEX IN CONVTB 
120 LT * LTO 

125 IF(LT.GT.LTE ) CALL ERROR 1 
IF(CH(LT).EQ.CHX) GO TO 130 
LT = L T + L TNE XT ( LT ) 

GO TO 125 

INTERPOLATE FOR CONVECTEO PROPERTIES 
SCALE THE PSI TABLE TO CONFORM TO THE LPSI -TABLE IN /CONVTB/ 

130 NI = NPT(LT) 




c 


I = LT4LPSI I L T ) 

12 = I«NI 

IFIK1.EQ.1 .AND. NK. tU. 1 I PSIl=PSll-8. 

PS! 1 = 8.*AINT(PSIl/8.) 

F = XCHU2-D/8. 

no 140 KN=l »NK 

140 PSI <KNI = (PSl(KN)-PSt ll*F 
IT = LT + LTTUT) 

IP = LT*LPT(IT) 

IS = L T + LRCU ( L T ! 

CALL LSPFITCCHI 1) ,CH( ITJ ,NI , PS l , TT ( Kl ) ,NK , 0! 
CALL LSPF IT (CHI I ) »CH{ IP) , NI • PS I • PT < K l ) , NK , 0) 
CALL LSPF IT1CHI I } ,CH( IS) ,N! , PS 1 » RCU ( K1 ) » NK , 0) 
CALL SE TM ( ItCRGILT ) * RGX I Kl ) ,NK ) 

CALL SETM( 1,C2CP(LT) ,C2CPX(Ki >,NK) 

CALL SE TM ( 1 v FGR ( L T > , FGRX I K l > , NK ) 


C WAKE DISPLACEMENT THICKNESS 
C SEARCH FOR X2-SUBTA8LE 

IF(M.GT.MB) GO TO 200 
X2J = X2(J) 

D I SP ( K- 1 ) =— 1 . 

LW = L WO 

155 IF(LW.GE.LWE) GO TO 190 

IF(X2W(LWJ . EQ.X2J ) GO TO 170 
LW = LW+L WNE XT ( LW ) 

GO TO 155 

C FIND TRAILING EDGE SI IN THE FLOW ADJUSTMENT TABLE, S1F 

170 LF = LFO 

175 1F(X2F(LF).EQ.X2J» GO TO 180 
LF = LF+NFCOLS 

IF(LF.LT.LFE) GO TU 175 
CALL ERR0R1 

C INTERPOLATE FOR WAKE DISPLACEMENT THICKNESS# DSTAR 

180 SIFTE = S1(M)-S1FILF ) 

C Sl-FROM-T.E. 

IF( S1FTE.LE.0. ) GO TO 190 
N = (LWNEXT(LW)-2)/2 

LSTAR = LW+N 

CALL LSPFIT(S1W(LW),DST(LSTAR),N, SiFTE.OI SPIK-i ) ,1, 0) 
I F( D I SP ( K- i ) ) 184,184,186 
184 DISP(K-1 )=-l. 

GO TO 190 

186 WAKE = .TRUE. 


C LOOP FOR NEXT CHANNEL 
190 WADO = WSTA(K-l) 

GO TO 105 


C USE CONSTANT DENSITY APPROXIMATION FOR MAJCTR . LE . NODE NS 
200 IF(MAJCTR.LE.NDDEnS) CALL SETMI l,0.,FGRX,K-l) 

RETURN 

END 

QVERL A Y ( STC 1 1 » 3 ) 

■ 3 ^ 



♦DECK MAT INV 

SUBROUTINE MAT I NV ( Y I J f N, UNI T , M, DE T , I N1 , I N2 ♦ NO • IF > 
CMATINV DUMMY (CDC) MAT I NV SIMULATOR 

DIMENSION YI J( I ) fUNI T( 1) » INK L) «IN2(1) 

NN = N*N 

CALL SETM{ 1,0.,UNIT,NN» 

N 1 = N ♦ 1 

DO l L = 1 < NN » N 1 

1 UN I T ( L ) = 1. 

CALL LRMDS1 ( Y I J ,N» I N l , I N 2 ,DE T , I F , N ) 

I F ( DET.EQ.O. ) CALL ERROR1 

CALL DBSRT1 (UNI T,N,IN1 . I N2t YI J,N,N) 

2 RETURN 
END 


-MAT INV- 
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♦ Of OK 00 P 2 

SUBROUT INI FTP! IMA, MB, W S TA ,0 I SP , WAKE , TT , PT , L AM, RGX , C2CPX , F GR X ) 
♦IIP! — TT, PT, AND RCU FOR STREAMLINES -TTPT* 

I.OGICAl WAKE 

REAL LAMI25) 

0 1 Ml NS ION W‘>! AI2b ),DI SP ( 25) , TT (25) ,PT(2b> , 

1 RGX( 2S ) ,C2CPX< 25) ,FGRX (25 ) 


input- 

MA = FIRST FIELD POINT 

MB = LAST FIELD POINT 


OUTPUT- 

WSTA = LIST OF STREAM FUNCTION VALUES 

0 I S P ( K ) =NON-/ ER 0 FOR POSSIBLE SLIP CONDITION BETWEEN STREAMLINE 
K AND KM, U THE R h I St D1SP(K)*0. 

= DISPLACEMENT THICKNESS OF WAKE IF POSITIVE 
WAKE = .TRUE. IF THERE EXISTS ANY WAKE DISPLACEMENTS. 

TT = INTERPOLATED TOTAL TEMPERATURE 

PT = INTERPOLATED TOTAL PRESSURE 

L AMBD A= LAMINA THICKNESS IN THIRD DIMENSION, BLOCKAGE EFFECT 
RCU = INTERPOLATED ANGULAR MOMENTUM ♦♦♦NOT NOW IN USE 

RGX = GAS CONSTANT 
C2CPX = SPECIFIC HEAT 

FGRX = 1. /(GAM-1. )= FUNCTION OF GAMMA FOR CALCULATING DENSITY 
NOTE - LENGTH OF W ST A , TT , PT , RCU-L I ST S IS MB-MA+1 


C 


COMMON /IXORIG/ L HO , LHE , LBDO ,LBDE , LTQ, LTE , LWO,LWE, LFO,LFE, 

♦ LO,LESTA, L0UMI8), 

♦ MO , NM , N J ,NFCOLS» MAXN J , MAXOL , MAXNM , MAXLE , 

♦ LEO, LEE. LRO, LRt » LRD 

DIMENSION LIMITSI2A) 

EQUIVALENCE (LIMITS, LHO) 

COMMON /SLTAB / W( 128),X2(l2d),SLCHN(l28) 

INTEGER SLCHN 

TABLE OF CONVECTED PROPERTIES 


INDEX- LT=L TO,L Tt 

COMMON /CHDATA/ CH (1) , LTNE XT (1 ) , NPT ( 1 ) , LPS I ( 1 ) ,LTT ( 1 ) , LPT ( 1 ) , 

1 LRCU ( 1 ) , 

2 CRG( 1) ,CPGJ( 1 )»C2CP( 1) , QGAM ( 1 ) ,FGT( 1 ) ,FGP( 1 ) , 

3 FGR( 1),AREATB(A85) 


INTEGER CH 
DIMENSION XCH(l) 

EQUIVALENCE (CH,XCH) 

SEE OTHER LISTING OF TTPT FOR EXPLANATION OF VARIABLES 
FLOW ADJUSTMENT TABLE 
INDEX- LF=LFO,LFE 


DIMENSION 

EQUIVALENCE 
DIMENS ION 


X 1 F ( 1),X2F(1),X1BF(1)»X1AF(1) , 

S 1 F ( l) ,NCHB( l ) , NCHA ( 1 ) » JORDER ( 1 ), VNR ( 12 ) 

( LFB.X1BF ) , ( LFA , X l AF ) , ( LRF , NCHB) , (LRXF.NCHA) 
LFBI 1 ) ,LFA( 1 ) ,LRF (1) ,LRXF(1) 


TABLE OF WAKF DISPLACEMENT THICKNESS 


INDEX- LW=L WO ,L WE 

DIMENSION X2WI1 ) ,L WNt XT I 1 ) ,S 1 W ( A 7 ) 


n i mi nsion dsk i) 

EQUIVALENCE (DST,S1W) 

SUBTABLE ARRANGEMENT IS- 


7 
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*DECK DUP 1 

SUBROUTINE LF I T 20 ( X , Y * TO , NXY ) 

♦LFIT2D LINEAR SURFACE INTERPOLATION -LFIT2D- 

C IN A RECTANGULAR GRID 

DIMENSION X ( 2 1 ♦ Y I 2 1 »T0 ( 2 1 


INPUT- 

X * Y = LIST OF COORDINATES AT WHICH INTERPOLATED VALUES ARE TO BE 

NXY = NO OF COORDINATE POINTS 

NXT = NUMBER OF XT 

NY T = NUMBER OF YT 

XT = X-GRID OF T-TABLE 

YT = Y-GRID OF T-TABLE 

T = TABLE OF VALUES 

NOTE - NUMBER OF T-VALUES IS NXT*NYT « ORDER IS ILLUSTRATED BELOW 


YT (NYT )- 

T l 3 > 

Tib) 

T INXT*NYT) 

YT<2) - 

T( 2) 

T ( 5 I 

T ( 8 ) 

YT m - 

T ( 1 J 

T (4) 

T ( 7 ) 


X T ( 1 ) 

X T ( 2 ) 

XT(NXT) 


C OUTPUT- 

C TO interpolated VALUES AT X,Y 

COMMON /CTHICK/ NXT,NYT, XTI20I, YT(20> ,TI78) 
COMMON /ERASE / DUMUOOI , Tl( 2001 ,T2<200) 


C FIND CORRECT X-INTERVAL 

I = 1 

M = 1 

ISV =0 
100 NCOUNT = 0 

105 IFIXIMI.LT.XTII )) GO TO 110 

IF(XIM) .GT.XTI I + ill GO TO 120 
F = ( X(M)-XT(I1 1/IXT II + n-XTII ) J 

GO TO 150 

110 I F ( I.EO.l) GO TO no 
I =1-1 

GO TO 125 

120 IF( ( I+ll.GE.NXT) GO TO 145 
I =1 + 1 

125 NCOUN T = NCOUNT + 1 

IF(NCOUNT.GT.NXT) CALL ERROR 1 
GO TO 105 
140 F =0. 

GO TO 150 
145 F =1. 


C INTERPOLATE WRT Y 

150 I F I l.EQ.ISV) GO TO 160 
I J 2 = I *N YT ♦ 1 

IJ1 = IJ2-NYT 

CALL LFIT1(YT,T( IJl) ,NYT, Y,T1,NXY) 
CALL LFITHYT.TC I J 2 > ,NYT, Y,T2,NXY) 
ISV = I 



C 


INTERPOLATE WRT X 



160 T0(M) 


F *T2( M ) ♦ < 1 »-F )*T l (M ) 


M = M4-1 

IF(M.LE.NXY) go TO 100 

.. FND LOOP FOR IN TERPOLA T I ONG T01M) AT X l M) , Y I M) »M=1 *NXY 

RETURN 

END 
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LOGICAL 


ONCE » SET AG 


DATA KLE/2HLE /» KTE/2HTE/, KF IE LO / 5HF I ELD/ 

OATA KFAR/6HFARFLD/, KFREE/4HFREE/ , KPRE S/4HPRES/ • KSOL I D/5HSOL I D/ 
DATA ONCE/. FALSE./ 

C CHECK FOR INCORRECT CHANNEL INPUT NAMES 
LH = L HO 
GO TO 45 

C LOOP THROUGH BOUNDARY TABLE TO SEE IF CHNAM ( LH ) IS REFERENCED 

32 LB = LBDO 

35 I F ( CHNAM ( LH ) . EQ .CHNAME (LB) .UR. CHNAM(LH) .EQ.CHNAMEILB+l) )GO TO 40 
LB = LB+LBNEXT < LB ) 

IFILB.LT.LBOEl GO TO 35 
C NO REFERENCE FOUND FUR CHNAMILHJ 

ERR = .TRUE. 

WRITE (6,1035) CHNAM ( LH ) 

1035 FORMAT (57H *** ERROR - BOUNDARY INPUT DATA DOES NOT REFERENCE CHN 

1=, A6) 

C INDEX TO NEXT CHANNEL 

40 LH = LH+LHNEXT ( LH ) 

45 IF ( LH.LT.LHE ) GO TO 32 

C LOOP THROUGH STATION TABLE TO INSERT SPECIAL BOUNDARY TYPES 
L = LO 


C LOWER BOUNDARY 

100 NAMB = NAMELB(L) 

KTYPE = TYPELB(L) 

ITVL = ILB(L) 

IRET = 0 
GO TO 500 

150 TYPELB( L )=KTYPE 

IF(KTYPE.NE.KSOLID) NAME LB (L ) =NAMB 

C UPPER BOUNDARY 

NAMB = N AMEUB ( L ) 

KTYPE * TYPEUB(L) 

ITVL = IUB(L) 

IRET = 1 
GO TO 500 

250 TYPEUBIL )=KTYPE 

IF (KTYPE. NE. KSOL ID) NAME UB ( L ) =NAMB 


C INDEX TO NEXT STATION 
L = L+LNEXTIL) 

IF(L.LT.LESTA) GO TO 100 
RETURN 

** GENERAL LOGIC FOR EITHER UPPER OR LOWER BOUNDARY 
NAMB = BOUNDARY NAME 
KTYPE * BOUNOARY TYPE 

500 IF(KTYPE.EQ.KLE .OR. KTYPE. EO.KTE .OR. KTYPE. EQ. KF I ELD ) 
* GO TO 599 



C 


CHECK BOUNOARY TABLE TO FIND SEGMENT NAME IF TYPE=SOLID 
SETAG = .FALSE. 

LB = LBF(NAMB) 
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NAM HD = NAM 8 

IF (KIYPE.NE.KSOLIDI GO To 520 
l H X f J = LR2 I ( LB) 

IMLHXN.EQ.O) GO TO 520 
LUX = L BZ 1 ( LB ) ♦ 3* I TVL-3 

L|jX = INDEX (RELATIVE TO SUBTABLE ORIGIN) QF THE 

INTERVAL OF THE OL-BOUNDARY INTERSECTION POINT 
LHI = LB 

510 IF(LBA(LBl).LE.LbX .AND. LBB(LBl).GE.LBX) GO TO 515 
LB1 = L B 1 ♦ 3 

IFILBl.LT .(LB + LBZl (LB) ) ) GO TO 510 
CALL ERROR 1 

CHECK FOR FIRST OF DOUBLE POINTS ON UPPER BOUNDARY 
515 miRET.EQ.O .OR. LBX . NE .LBB< LB 1 ) .OR. (LBl + 3) .GE. ( LB+LBZ 1 ( LB) ) 

* .OR. LBA(LBl + 3).NE.(LBB(LBl)+3) ) GO TO 518 

change station-table reference to the 2nd pt <ist streamwise ptj 

NAMBD = BDNAMEI LB 1 I 
LB1 = LBl+3 
lUB l L ) - IUB( L ) + 1 
SETAG = .TRUE. 

518 NAMB = BDNAME(LBl) 

DETERMINE IF GIVEN BOUNDARY NAME HAS BEEN SPECIFIED BY 
USER INPUT AS A SPECIAL BOUNDARY TYPE 
520 I F ( NAMB .EQ.FARFLD( 1) .OR. NAMB . EQ . FARF LD ( 2 ) ) KTYPE=KFAR 
IF(NAMB.EQ.FREEU) .OR. NAMB .EO.FREE ( 2 ) ) KTYPE=KFREE 
IFINAMB.EO.PRESI 1 > .OR. NAMB. EQ. PRES (2) ) KTYPE=KPRES 

C SET ISTAG EQUAL TO ZERO AT THE SOLID/FREE BREAK POINT 

IF ( .NOT. SETAG .OR. ( NAMBD .NE .FREE (1) .AND. NAMBD. NE. FREE ( 2 ) .AND. 

* NAMBD. NE. PRESI 1 ) .AND. NAMBD. NE .PRES ( 2 )) ) GO TO 530 

M * MUB ( L I 

CALL GET I X 
ISTAG = 0 
CALL SAVIX 

C FAR-FIELD BOUNDARY GEOMETRIC DATA 

530 IF( KTYPE.NE.KFAR .OR. ONCE) GO TO 599 
LB1 = LB+LBZ1UB) 

LB2 = LB+LBNEXT (LB )-9 

RFFREF= RBTUB2) 

ZDN1 = ZBTIL 82 ) 

ZDN25 = ZBT(LBl) 

WRITE (6,1530) RFFREF , ZDN 1, ZDN2 5, NAMB 
1530 FORMAT( //2X, A1HTHE FAR FIELD INTERFACE BOUNDARY IS AT R=,F9.3, 

*11H BETWEEN Z« , F9 . 3, AH AND, F 9 .3 , IH . , 8H ( BDY= , A 6 , 1 H ) ) 

C SET UP FAR FIELD SOLUTION MATRIX 

CALL FRFDNZ 
ONCE = .TRUE. 

C RETURN 

599 I F ( I R h T ) 150, 150,250 
END 




non 


NFF = NF 

C PARABOLIC FIT AT END POINTS OF FARFIELD BOUNDARY 


RA 

= 

RFF I 1 ) 

ZA 

= 

ZFFI 1) 

ZASQ 

= 

1./<Z1-ZA)**2 

A 1 

= 

Rl-MRA-Ri )*Z 1**2* ZASQ 

Cl 

- 

( K A-R l ) * Z A SQ 

B 1 

- 

-2.*C1*Z1 

RB 

= 

RFF ( NFF ) 

ZB 

= 

ZFFINFF ) 

Z AS 0 

= 

1 ./ ( / 25-ZB )**2 

A 2 5 

= 

R 2 54 ( RB-R ti 5 ) *Z2 5 *>2*ZAS0 

C25 


( RB -R 25 I *Z AS U 

B 2 5 

= 

- ? . *C 2 5 * / 2 5 

locate 

ENuPUINT INDICES 


DO 200 K = 1 , 2 5 

I F ( ZDNlKI.GE.ZA ) GO TO 201 
2 JO CONTINUE 
2 0 i LU = K-i 

DO 210 K=l,25 

I F ( Z UN ( K ) • GT • Z B ) GO TO 211 
. 210 CONTINUE 

211 LD = K 

C INTERPOLATE POINTS IN STC SOLUTION TABLES 
NUM = LD-LU+1 

I F ( PKFF.NE.O. ) CALL L SPF I T I ZF F ♦ RFF t NFF , ZDN ( LU+ 1 ) * RDN( LU + 1 ) . 
* NUM, j ) 

INTLRPUL&TI CO-ORDINATE DERIVATIVES ON FAR-FIELD BOUNDARY 
IT ( I . N I .0. ) GO TO A 

CALL Llll l(ZFF,PH|FF,NFF ,ZDN1LU*1) ,UR0N(LU+1) ,NUM) 

GO TO *>* >'j 

A CALL LSPf mZFF,PHlFF,NFF,ZDN(LU+l I»DRDNILU+1 ) ,NUM,0) 

C f ILL HID POINTS OF ZDN » DR UN TABLES 

555 DO 556 K=1»LU 

RON ( K )= A1+B1*ZDN(K) +C 1* ZDN I K I * *2 

55 6 DRDN ( K ) = B 1 ♦ 2 . *C 1 *ZDN ( K ) 

00 557 K=LO, 25 

RDNIK )= A25+B25*2DN(K)+C25*ZDN(K)**2 
5 5 7 ORDN ( K ) = B2 5 + 2 . *C 2 5* ZDN ( K ) 

C ADJUST DERIVATIVE AT ZDN POINTS CLOSEST TO 
C UPSTREAM / DOWNSTREAM STC POINTS 


D/UN = / ON ( 2 ) -/ DN I l ) 

DZ A 1 = ZA-ZDN(LU) 

l)/At * /ON(L!J+ 1 ) -/A 
LUC = UJ 

IF( 0/ A 2 . G T . DZ A 1 ) GO TU 558 
LUC = I 0+1 

558 AA = ( ZA-ZDNILUC M /DZDfi 
SP * B1+2.*C1*ZUN(LUC » 

I F ( PRFFI.NE.O. ) GO TO 560 

CALL LFIT1(ZFF,PHIFF,NFF , ZON(LUC) , SB * 1 J 

GO TU 561 

560 CALL LSPFIT(ZFF,PHIFF»NFF ,ZDNILUC) .SB, 1,0) 

561 ASSIGN 562 TO L GO 
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5 6 / / UPON! LUCK SP * ( .6«AA)«SD*(.b-AA) 

(.1) III LUi , ( 662,6 ) 

66, U/Ai = /D-ZUN(LO) 

N/ A ^ - / UN ( L U- 1 ) - Z B 
LUC = LD 

IK ABSUJZA2) .GT. AHS(UZAl) I GO TO 563 
LUC = LD-1 

565 AA = (ZDN(LUC)-ZB)/UZDN 
SP = B25+2.*C25*ZDN(LUC) 

11- ( PRFFI.Nt.O. ) GO TO 565 

CALL LF 1 T 1 ( ZFF.PHIFF ,NFF , ZON ! LUC ) , SB , l ) 

GO TO 566 

565 CALI L SPf I T ( Z FF ,PHlFP ,NFF ,7I)N(LUC ) ,SH,i , j) 

666 ASSIGN 6 TO L Gll 
GO TO 6622 

CALCULATE VELOCITIES ON FAR FIELD BOUNDARY 

5 DO 10 1=1,25 
SUM = 0. 

DO 9 J= 1 , 25 

9 SUM = SUM+ZIJ! I , J)*DRDN!J) 

10 UDN ( I ) = ( 1 .+SUM)*U1NF 

I F ( PRFF.EQ.O. ) GO TO 20 
WRITE 16,16) 

WRITE (6,15) (I,ZDN(I),RDN(1) , DRDN ( I ) ,UDN ( I ) , I =1 , 25 ) 

14 FORMAT! //3X, 1HI , 10X, 3HZDN , 13X.3HRDN, 1 3X , 4HDRDN , 1 2 X , 3HUDN/ / ) 

15 FORMAT! 2X, 12, F 17. 6,F 16.6, 1PE 1 7.6, OPF 15.6) 

<?0 RETURN 
END 
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•DECK INSTA 

SUBROUTINE INSTA ( LNE W , LB A SE . L 3, DOWNS ,MA,MB ) 

• INSTA- INSERT A STATION -INST A- 

10GICAL DOWNS 

INPUT- 

LNEW = LOCATION IN S TA T I ON- T AB LE OF NEW STATION 
LBASE = LOCATION OF BASE STATION 

L 3 = LOCATION Of DOWNSTREAM UJR UPSTREAM) STATION 

DOWNB = T IF L3 IS AN UPSTREAM STA, OTHERWISE »F 
MA f MB = NEW STATION FILED POINT INOEX LIMITS 
2.R.PHI1 FIELD VALUES 

OUTPUT - 

LNE W = STATION FOLLOWING NEW STATION 


REAL 

LOGICAL 

LOGICAL 

COMMON /C BE AM 2/ 
LOGICAL 

INDEX- M=MO,NM 


LTOtLTE * LWO.LWEt 


COMMON /ALLCOM/ MACHA , PS A , TS A , P TA # TT A, AX I A ,RGA, GAMA * 

1 MACHC»PSC ,TSC,PTC,TTC, AXI C ,RGC, GAMC * 

2 DAXI T,SCALEA, TTE.CHOTST 

REAL MACHA ( 1 ) tMACHC 

LOGICAL AXIA.AX1C 

LOGICAL CHOTST 

COMMON /C BE Am 2/ DR , DZ * YPA , YPb ,F , G , D X , YQDX , ZM , RM , ANGM , CURVM, S I M, 

I RZONLY, ANGCHD, SINTVL, YPASQ , YPAB , YP8S0 

LOGICAL RZONLY 

INDEX- M=MO,NM 
COMMON /Cl / l ( 300) 

COMMON /CR / R { 300 ) 

COMMON /CS2 / S2 ( 300 ) 

COMMON /CSI / S 1 ( 300 ) 

COMMON /CPH1I / PHI 1 { 300 ) 

COMMON /CM / JMS( 300) 

COMMON /CCURV / C UR V ( 300 ) 

COMMON /CR / R ( 300 ) 

COMMON / C I D F X / M , J , MU » M D 1 1 S T AG 

COMMON /IXORIG/ L HO* LHE t LBDO »L BDE » LTOtLTE f LWO.LWEt LFOtLFE, 

* LO,LESTA, LUUM ( 8 ) t 

* MO t NMt NJ.NFCOLSt MA XN J, MAXOL , MAXNM , MAXLE , 

* LEO, LEE, LRO, LRE , LRD 

DIMENSION LIMITS(2A) 

EQUIVALENCE (LIMITS, LHO) 

COMMON /SLTAB / W { 128 ) , X 2 ( I 2 8 ) , SLCHN (128 ) 

INTEGER SLCHN 
STATION TABLE 
INDEX- L=LO,LESTA 

SCHUK E = STATION CHOKE INDICATOR < ADJWF , BRHS , WR IOUT ) 

MCL = SHARP CORNER INDICATOR ( BLDTBS ) 

MCL = FIELD INDEX OF CONTROL STREAMLINE ( PTMOVE , FLOBAL ) 

COMMON /CHDATA/ X H 1 ) , LNE XT ( 1 ) , MLB U ) , MUBU) , PRI M ( 1 ) , ^ 

L TYPELB(l),NAMtLB(l),ILB(I) ,FLR ( l ) , S1LB( l ) , • 

1 T YPF UB ( I ) » NAMFUB ( 1 ) , I UB ( l ) , F(JH fl ) , S1UB( I ) , 4 

3 VMB( l),E)WDV( U, X2CL(l),VCL(l l,MCL(A8l) 

LOGICAL PRIM 

INTEGER TYPELB, TYPtUB 

DIMENSION SCHOKEU) 

EQUIVALENCE { SCHOKE , DWDV ) 


COMMON 

COMMON 

COMMON 

COMMON 

COMMON 

COMMON 

COMMON 

COMMON 

COMMON 

COMMON 


/Cl / 
/CR / 
/CS2 / 
/CSI / 
/CPH1I / 
/CM / 
/CCURV / 
/CR / 
/ C I D F. X / 
/IXORIG/ 


LOGICAL 
INTEGER 
DIMENS ION 
EQUIVALENCE 


COMMON /CATAN3/ DANG 


o o o 


COMMON /CBUYPl/ 
COMMON / C B I T S / 
COMMON / C M A X I I / 
COMMON /CPI / 
COMMON /CPRINT/ 
COMMON /CVM / 
COMMON /PRASE / 


ANGOtCURVD 
R I TS , IBL ANK 

MAXI T ,MA JCTR.GREF IN.EOUM 
P I ,TWUPI » PI Q2 , P I 04 1 T ODEG , TOR AD 
P OUM 1(31 »PREF IN 
VMI300) 

ASL ( 800) 


I NT fc OCR HDYN AM ,F ARFLO.FREE.F I ELO, PRE S , SOL ID 

LOGICAL OPU.UPD 


DATA FARFLD/6HFARFLD/, F I ELD/ SHF I ELD/ * FREE MHFREE/ . PRES/4HPRES/ , 
* SOL 10/5HS0L 10/ 


*** RELOCATE TO MAKE ROOM FOR THE NEW STATION 

INITIALIZE NEW-STATION VALUE TO THE BASE-STATION VALUES 
CORRECT THE STA-TAHLL INOICIES- L-ENO, L-BASE, L-THREE, L-UPSTREAM 
LN = LNEW 
NMOVE = LN— I - LESTA 
LB = L BASE 

CALL MOVE ( 2 * X 1 ( LN ) , X L ( L N* 20 I ,NMOVE , D, Xl( LB I , XU LN ) , 20 * L ) 

LESTA = LESTA+20 
LT = L 3 + 20 

LU = LB 

I F ( .NOT . DOWNB ) GO TO 60 
LB = LB+20 

LT = L3 

LU * L3 

C UPDATE THf POINTERS TO THE FIELD-TABLE 
60 NPTS = MB-MA ♦ l 
LNEX T ( LN ) =20 
CALL S T TOF I < LN , NP T S ) 

C*** DEFINE STATION-TABLE VALUES FOR THE NEW STATION 

XKLN) = .5*<X1(L0) + X1(LT)) 

ML B ( L N ) =M A 
MUB ( L N ) =MB 
PRIM(LN)-. FALSE. 

X 2C L ( L N ) =B I T S 

C ♦* LOWER BOUNDARY S T A T ION- TA BLE VALUES 
M = MA 

CALL GETIX 
MX = MU 

IF(OOWNB) MX=MD 
LX = LU 

CALL STANUIMX, LX, UPPER) 

I F ( MX -ML B ( L X ) ) 210,220,250 
210 CALL ERROR l 

C LOWER BOUNDARIES OF NEW ANO BASE STATIONS ARE ON THE SAME SL 
220 IF( TYPELB(LB) .EO.F IELD) GO TO 250 
IF ( TYPELB(LB) .EQ.FARFLO) GO TO 260 

C FREE BOUNDARY 

IF( TYPELB(LB) .NE.FREE .AND. TYPELB ( LT ) .NE. FREE ) GO TO 22<* 

TYPELBILN )=FREE 


GO TO 260 


C PRESSURE BOUNDARY 

224 IF(TYPELB(LB).NE.PRES .AND. T YPELB t LT ) .NE . PRES) GO TO 230 
TYPELB(LN)=PRES 
GO TO 260 

C SOLID BOUNDARY 

230 TYP£LB(LN)=SOL ID 
BDYNAM= NAMELB(LX) 

NAMELBl LN )=BDYNAM 
ILB(LN)=ILB(LX) 

FLB(LN)=FLB(LX) 

S1LBI LN ) = S1LH( LX ) 

LD = LU 

CALL STANO(MU,LU» UPU) 

CALL STANO(MD,LD,UPD) 

DS1 = . 5* ( BARCS ( BOYNAM » I LB ( LU ) , I LB ( LD ) ) ♦ SUB (LD )-SlLB( LU ) ) 
IF ( UPU.OR.UPD) CALL ERROR 1 
IF(DOWNB) DS1=-DS I 

CALL BDYPTM(BDYNAM,ILB(LN),Z(M) ,R(M) ♦FLB(LN)»SlLB(LN)fDS 1 ,GMA ) 
I F ( GMA.NE.O. ) CALL ERROR 1 
PHI i( M ) = ANGD 
B ( M ) = . 5* ( R ( MU ) *B ( MD ) ) 

VM(M) = . 5* ( VM( MU ) +VM ( MD ) ) 

IF(VM(M).EO.O.) VM(M)*VM(MU+1 ) 

GO TO 300 

C INFIELD BOUNDARY 
250 TYPELB(LN)*FIELD 
ISTAG =3 
CALL SAVIX 
NAMELB(LN)=IBLANK 
260 I L B ( L N ) =0 

FLB ( L N ) =8 I TS 
SILBI LN ) =B I TS 


C** UPPER BOUNDARY S 
300 M = MB 

CALL GETIX 
MX = MU 

IF(DOWNB) MX=MD 
CALL STANO ( MX » L 
IF ( MUB ( LX )-MX ) 
310 CALL ERROR 1 


TAT ION-TABLE VALUES 


X, UPPER ) 
310,320,350 


C UPPER BOUNDARIES OF NEW AND BASE STATIONS ARE ON THE SAME SL 
320 IF(TYPEUBCLB).EO. FIELD) GO Tt) 350 
IFITVPEUB(LB).EQ.FARFLO) GO II) 360 

C FREE BOUNDARY 
LD = LU 

CALL STANO ( MU , LU , UPU ) 

CALL ST ANO( MD,LD,UPD) 

IF (TYPEUB(LB).NE.FREE .AND. TYPEUB ( LD ) . NE . FREE) GO TO 324 
TYPEUB ( LN ) =FREE 
GO TO 360 




C PRESSURE BOUNDARY 

324 IF (TYPEUB(LB).NE.PRES .AND. TYPEUB ( LD) .NE .PRES) GO TO 330 
TYPEU8(LN)=PRES 
GO TO 360 

C SOLID BOUNDARY 

330 TYPfcUB(LN)*$OLlD 
BDYNAM- NAME U8 ( LX ) 

NAMEUBI LN )=BDYNAM 
IUB ( L N ) = I UB (LX) 

FUB l LN ) =FUB l LX ) 

S1UB( LN I = S 1UB (LX) 

LD = LU 

CALL STANO(MU,LU,UPU ) 

CALL STANOlMD,LD f UPO ) 

IFI.NOT.UPU .OR. .NOT. UPO) CALL ERR0R1 

DS1 = .5*1 BARCSI BDYNAM , IUB(LD) ,IUB<LU) ) ♦ S LUB ( LU ) -S1UB ( LD ) ) 
IF ( .NOT .OOWNB ) OSi =-DSl 

CALL BDYP TM ( BDYNAM, I UB(LN) ,Z ( M) ,R ( M) , FUB ( LN ) . SlUB ( LN ) , DS 1 » GMA ) 
IF! GMA.NE .0. ) CALL ERROR 1 
PH I 1 ( M ) = ANGD-PI 
B ( M ) = . 5* ( B ( MU ) +B( MD ) ) 

VM(MJ = .5*<VM(MUMVM(MD J ) 

I F ( VM ( M ) . EQ .0 . ) VM(M) = VM(MU-1) 

GO TO 400 

C INFIELD BOUNDARY 

350 TYPEUB(LN)=FIELO 
ISTAG = 3 
CALL SAVIX 
NAMEUB!LN)=IBLANK 
360 IUB ( LN ) = 0 

FUB ( L N ) =B I T S 
SlU B ( LN I =B I T S 

C DEFINE THE FIELD POINTS BY CUBIC POLYNOMIAL INTERPOLATION ON SL- 
400 M = MA 

RZ ONL Y = .TRUE. 

IF ( TYPELB(LN) .EQ. SOLID) GO TO 420 
410 CALL GET I X 

DZ = Z(MD)-ZIMU) 

DR = R ( MD ) -R ( MU ) 

F = .5 

G = . 5 

ANGCHD= ATAN3(DR,DZ,PHll (MU) ) 

Y P A = PHI H MU ) - ANGCHD 
YPB = PH I l ( MO )- ANGCHO 
MS V = M 
MU SV = MU 
MD SV = MD 
M = MD 

CALL GFTIX 
I S T AGD= ISTAG 
MO = M 
M = MS V 

MU = MUSV 
I F I 1ST AGO . EO . 1 ) YPB=-YPA 
RZ ONL Y= .FALSE. 

73 ^ 



CALL BFI 

ZIM) * Z ( MU ) + ZM 

RIM) = RIMUJ+RM 

PH 1 1 ( M ) = ANGCHO+ANGM 

VM ( M ) = F*VM( HD ) +G*VM ( MU ) 

BIM) = F*B(M0) +G*B( MU) 

C CHECK FOR POINTS ON A SLIP LINE 

IFIM.EQ.MA .OR. WIJJ.NE.O.) GO TO 420 
ZIM) = .5*(Z IH-1)*Z IHI) 

M = M-l 

CALL GET I X 
M = MSV 

OZ = .25*1 Z(MUSV)-Z(MU)*ZIMDSV)-Z ( HD) ) 

DR = .25*(R(MUSV)-R(MU)+R(MDSV)-R(MD) ) 

Z 1 M-l > = Z(M)-DZ 
R ( M-l ) = R ( M ) -OR 
ZIM) = ZIM) +DZ 
RIM) = RIMJ+DR 
420 M = M ♦ 1 

IFIM-MB) 410,425,500 
425 IF(TYPEUBILN).NE.SOLIO) GO TO 410 

C CHECK FOR OUT-OF-ORDER POINTS 
500 NORDE R= 0 
502 NOROER* NORDER+l 

IFIN0RDER.GE.20) CALL 6RR0R1 

MX 1 * 0 

MAPI * MA+l 

MSV = MA 

S2 I MA ) = 0. 

DO 520 M=MAP 1 ,MH 
DR = RIM) -R I M- 1 ) 

DZ = ZIM) — ZIM— l) 

S2IM) = S 2 ( M- 1 ) ♦ SORT ( DR* ()R>DZ *D Z ) 

CALL GET I X 

IFIWI J ) .EQ.O. ) GO TO 5 lb 
ANG2 = ATAN3(DR,DZ,PHIl (M-l) ) 

ADANG = ABS I DANG-P 102 ) 

IF(MXl.NE.O) GO TO 515 
IF! ADANG. GE.PIQ2) MX1=MSV 
MSV = M-l 

515 I F ( ADANG. GE.P102) MX2=M 
GO TO 520 

518 IFl (M-1).EQ.MX2) MX2=M 
520 CONTINUE 

C DEFINE THE FIELD PT LOCATIONS BY UPSTREAM AREA DISTRIBUTIONS 
IFIMXi.EO.O) GO TO 999 
MX 1 = MAXOIMXl-NORDER, MA) 

MX2 = M I NO I MX2 + N0R0ER, MB ) 

WRITE (6,1550) MX1,MX2 
1550 FORMA T I 14H INSTA-MXl ,MX2 , ?I 6 ) 

MX 1 = M AXO I MX 1- l ,MA ) 

MX2 * M I NO I MX 2 ♦ 1 ,MB ) 

C ADD UP UPSTREAM AREAS 

M = MX 1 

CALL GET IX 
K * 1 

ASLIl )* 0. 



562 


C 


564 


999 


MIJM 1 = MIJ 

M = M* 1 

K = K4 1 

CALL GET IX 

AREA = SORT! (R(MU)-R(MUMH )*(R(MU>-R(MUML) ) ♦ 
(Z(MU)-Z(MUMin*(2(MU)-Z(MUMl) ) ) 
IF(AXIA) AREA*(R(MU)+R(MUM1) ) *ARE A 
ASL I K ) - ASL ( K- 1 ) +ARE A 
IF(M.LT.MX2) GO TO 562 
ASLNK = ASL(K) 

INTERPOLATE FOR COORDINATES 
DZ BA = Z(MX2)-Z(MX1 » 

DRBA = R ( MX2 J-RIMXl I 
DRSQBA= DRBA* (R(MX2)+R(MX1J) 

RMASQ = R ( MX 1 )*R( MX1 ) 

DVMBA = VM(MX2)-VM(MX1I 
M = MX 1+ 1 

K * 2 

F = ASL ( K )/ ASLNK 

Z(M) = Z (MX1 )+F*OZBA 

RIM) = R I MX 1 ) ♦F*DRBA 

IF I AX I A) R(M) = SQRT I RMASO + F*DRSOBA ) 

VM(M) = VMIMX1J+F* DVMBA 
M = M + l 

K = K + l 

IFIM.LT.MX2) GO TO 564 
GO TO 502 

LNEW = LN+20 

RETURN 

END 




ooooo o ooooooooo 


♦DECK PTMOVE 

SUBROUTINE PTMOVE 

♦PTMOVE POINT MOVEMENT ALONG STREAMLINES -PTMOVE- 

C POINT MOVEMENT ALUNG STREAMLINES TO OBTAIN AN ORTHOGONAL GRID 


INPUT- 
R,Z 
PHI 1 

51 

OUTPUT- 

52 
R.Z 
PHIL 
SI 


= COORDINATES 

= angle OF the streamlines 

= DISTANCES ALONG THE STREAMLINES 


DISTANCES ALONG THE ORTHOGONALS 
ADJUSTED coordinates 
STREAMLINE ANGLES (ADJUSTED POINTS) 
DISTANCES ALONG THE STREAMLINES (ADJUSTED) 


I 


COMMON /CBEAM2/ OR ,DZ , YP A , YPB ,F , G , D X , YQDX , ZM.RM , ANGM.CURVM, S 1M 

R ZONLY * ANGCHD* SINTVLt YPASQ, YPAB»YPBSQ 
LOGICAL RZONLY 


INDEX- 

M=MO , NM 


COMMON 

/CZ 

/ 

Z ( 300) 

COMMON 

/CR 

/ 

R ( 300) 

COMMON 

/CS2 

/ 

S2 ( 300 ) 

COMMON 

/CS1 

/ 

SI (300) 

COMMON 

/CP H I 1 

/ 

PH 1 1 ( 300 ) 

common 

/CM 

/ 

JMS ( 300 ) 

COMMON 

/CCURV 

/ 

CURV ( 300 ) 

COMMON 

/CR 

/ 

B( 300) 

COMMON 

/C IDEX 

/ 

M, J,MU,MD, ISTAG 

COMMON 

/IXORIG/ 

LHO.LHE, LBDOtLBDEt 


dimension 
equivalence 
common /cbend 


/CBITS 

/CCUBE 

/CGRAV 

/CPI 


LTO» LTE ♦ LWO « LWE * LFO.LFE, 

♦ LO.LESTA, LDUM ( 8 ) , 

♦ MO ,NM * N JfNFCOLS, MA XN J , MAXOL • MAXNM, MAXLE , 

♦ LEO, LEE, LROf LRE * LRD 

L I M I TS ( 2 A ) 

(LIMITS, LHO) 

/ NBCR(2)«ANGE(2) ,CURVE(2)»FB(2) 

/ BITS, BLANK 

/ NBC(2),C1(2),C2(2)»FEND(2) 

/ CG 

/ PI, TWO PI ,PIQ2,PI QA , T ODEG , T ORAD 
/CREFIN/ SG1,SG2,VMG1,VMG2 

NGR, NGZ, SGRl 10) ,GR( 10) , SGZ ( 10) , GZ ( 10 ) 

/SLTAB / W ( 128),X2(128),SLCHN(128) 

INTEGER SLCHN 
STATION TABLE 
INDEX- L=LQ, LESTA 

SCHOK E= STATION CHOKE INDICATOR ( ADJWF ,BRHS ♦ WRIOUT ) 

MCL = SHARP CORNER INDICATOR IBLDTBS) 

MCL = FIELD INDEX OF CONTROL STREAMLINE ( PTMOVE ,FLOBAL ) 

COMMON /CHDATA/ X 1 ( l ) , LNE XT l l ) , MLB ( 1 ) , MUB 11) , PRI M ( l ) , 

1 T YPE LB ( 1 ) , NAMEL B ( 1 ) , I LB ( 1 ) , FLB < 1 ) , S 1LB ( 1), 

1 TYPEUB ( 1 ) , NAMLUB ( 1 ) , I UB ( 1 ) , FUB ( l ) , S 1UB ( 1 ) , 

3 VMB ( 1 ) , D WDV ( 1 ) , X2CL(l),VCL(l),MCL(48L) 

LOGICAL PRIM 

INTEGER TYPELB, TYPEUB 


COMMON 
COMMON 
COMMON 
COMMON 
COMMON 
1 , 

COMMON 


r 


DIMENSION 


SCHOKE(l) 



o o 


FUUI VALENCE 


( SCHOKE • DWDV ) 


COMMON /CBDYPT/ 
COMMON /CEB / 

1 

2 

COMMON /CINNfcK/ 
COMMON /CMAXIT/ 
COMMON /CPTMOV/ 
LOGICAL 

COMMON /CTOLRL/ 

1 

COMMON /CVM / 
COMMON /ERASE2/ 

1 

LOGICAL 

COMMON / TR0U8L / 
LOGICAL 


ANGD.CURVD 

L tMA,MH#LX f lK»IKDIR#IKA,IKB* 

NK « K .ADSL tXCHOKfc.ADSlLB, AOS 1UB,GMALB,GMAUB, 

C F BOOM ( 1 7 ) 

I NRC TR.RDUM, WINNER (16) tCNVF (16) 

MAXI T *MA JCTR ,GREF INtEDUM 
VELPOT»ICOB# C PTDUM ( 2 ) 

VELPOT 

TOLRL,MAXSWP,CLEN,DS2MX f TOLDS2,NSWP, 

OSIDMP ,DSlMXA,DSlMXBtOSlRMS»ES2MXtOSlRMO 
VM ( 300 ) 

X 1 L ( 128) , SCI 128),VC(120),VOS(128)tFVDS(128), 

SCX ( 128) , PHI 2(96) .DS1C96) ,ZK(96) ♦ RK ( 96 ) » WE ZPT ( 96 ) 
WEZPT 

ERR.ERRMAJ, INERR,PRERR 
ERR, ERRMAJ,INERR,PRERR 


INTEGER E IELD, SOL ID* TE 

LOGICAL OLWNCL 

DATA F I ELD/5HF IELD/» NOMC L/6HN0 MCL/» SOL I D/5HS0L I D/ , TE/2HTE/ 
OAT A LE/2HLE/ 


C INITAILIZE 
COE F = 0. 

I F ( DS1RM0.NE.0. ) COEF=-DS 1DMP/DS1RM0 
OS l MX A= 0. 

DSIMXB= 0. 

NDSi = 0 
SOS 1SQ= 0. 

C USE PARABOLIC END CONDITIONS ON THE ORTHOGONAL SPLINE FIT 
NBCB< 1 )=0 
NBCB ( 2 ) =0 
FB( 1) = 0. 

FB( 2) = 0. 

C **** C ALCULATE POINT MOVEMENT ALONG CONTROL STREAMLINE 

BUILD ARRAYS OF ARC DISTANCE AND VELOCITY 
BY LOOPING THROUGH THE S TAT I ON- TABLE 
L = LO 

LAST = 0 

C FIRST POINT ON CONTROL STREAMLINE 
210 IF(L.GE.LESTA) GO TO 900 
IC = 1 
LSAV = L 
OLWNCL= .FALSE. 

C OLWNCL = ORTHOGONAL 

SC( l) = BITS 
X 1 A = X 1 ( L ) 

XCNTRL* X 2CL ( L ) 


LINE WITH NO CONTROL SL, T OR F 

2 ~ 3 # 


220 X 1 L ( IC » =X 1 ( L ) 



I F« SC < ll.NE.BITS) GO TO 240 
MA » MLBIL) 

HB = MUBIL) 

DO 230 M=MA, MB 
CALL GETIX 

IF(X2( JJ-XCNTRL) 230»232f230 
230 CONTINUE 

I F ( IC.EO.l) GO TO 245 
GO TO 243 

2 32 IH IC.EO.l) GO U) 240 

C (THE UPSTREAM OL OF THE KIGIlJN IS AT A T.E. IT DOES NOT INCLUDE AL 

X 1 L t L ) — X 1 A 
SCI 1) = SllMU) 

VC( 1) = VM(MU) 

I F C .NOT.VELPOT) VC I 1 ) =500 . 

240 SC ( IC ) = S11M) 

SC( IC )= S1IM) 

VC( IC ) = VM(M) 

IF t .NOT.VELPOT) VCIIC)*500. 

MCLIL )- M 

C IS CONTROL SL INCLUDED IN THE STATION STREAMLINES 

IF(M.LT.MLB(L) ) CALL ERR0R1 
IFIM.LE.MUBI L ) ) GO TO 244 

C CONTROL SL DOES NOT CROSS THIS OLt CHECK FOR FIELD BOUNDARIES 

243 IF(TYPELB(L).NE. FIELD .AND. TYPEUB ( L ) . NE . F I ELD) CALL ERROR! 

OLWNCL= .TRUE. 

MCL ( L ) = NOMCL 
GO TO 245 

24 4 M = MD 
CALL GETIX 


C INDEX TO THE NEXT STATION 

245 IF(PRIMU) .AND. IC.NE.l) GO TO 250 
L = L+LN6XT ( L ) 

IC = IC + l 

GO TO 220 

C LAST POINT ALONG CONTROL STREAMLINE 
250 X IB = X 1 ( L ) 


C MODIFY STAGNATION POINT VELOCITY TO OBTAIN SMOOTH CURVE 
C ASSUME VELOCITY IS CONSTANT TO WITHIN 2 L.E. RADII 

IF ( VCI n.NE.O.) GO TO 254 
M = MCULSAV) 

SC21 = SC ( 2 ) - SC ( l) 

F = 2 • / l SC21*AMAX1(CUKV(M)» 1 • E -6 ) ) 

VC(l) * VC(?)*AMAXllO.,i.-F ) 

254 IF! VCI IC) .NT .0. ) GO TO 258 
M = MCLIL ) 

SC21 = SCI IC)-SCI IC- 1 ) 

F * 2./ISC21*AMAXlICURVIM) t iE-6)> 

VCIIC)* VCI IC-l)*AMAX!IO.tl.-F ) 



C INTEGRATION OF VC*DSC (I.E. CALC OF POTENTIAL FUNCTION) 
258 VDSID* 0. 

CALL LSUMI SCtVC » IC» VDS) 



C INTER PIJLATI ON FOR f)R T HUGUN AL POSITIONS 
CONST = VDS ( IC ) /( X1R-X1A ) 

NIC = I C 
DO 26u IC=1,NIC 

260 F VDS ( IC)=(X1L(IC)-X1A)*C0NST 

CALL LSPFIT(VDS,SC,NIC, F VDS , SC X , N IC , 0) 

C LOOP THROUGH THE SAME STATIONS, ONCE FOR REGULAR OL-S, AGAIN FOR OL 
LOOP = 1 

^♦♦♦♦CALCULATE ANGLE AND ARC LENGTH ALONG THE ORTHOGONALS 
100 L = LSAV 

1C = 1 

RZ()NLY= .FALSE. 

C LAST = LAST ORTHOGONAL OF THE PREVIOUS REGION. (ALREADY ORTHOGONA 

IT (L. fcO. LAST) GO TO 450 

102 I F ( LOOP . EO . 1 .AND. MCL ( L ) .E U . NOMC L ) GO TO 450 
IF(L00P.E0.2 .AND. MCL ( L I .NE .NOMCL ) GO TO 450 
MA = MLB(L) 

MB = MUB ( L I 

NK = MB-MA+i 

C RELOCATE Z,R TO ALLOW FOR DOUBLE SL-S 

M = MA 

K = 1 

308 ZK ( K > = Z ( M I 
RK ( K ) = R ( M ) 

WEZPT (K ) = . FALSE. 

CALL GET I X 

I F < W( J ) .NE.O. .OR. K.EO.l) GO TO 310 
WEZPT(K-1)=.TRUE. 

GO TO 312 
310 K = K ♦ 1 

312 M = M*1 

IF(M.LE.MB) GO TO 308 
NKX * K-l 

PH I 2 ( 1 )=PHU(MA)+PI02 
S2 ( MA ) = 0. 

CALL BFAS(ZK,RK,PHI2,S2( MA), 1,NKX) 

C LOCATE BACK PH 1 2 AND S2 IF DOUBLE SL OCCURED 

IF(NKX.EQ.NK) GO TO 322 
K = NKX 

316 IF ( .NUT. WEZPT (K ) ) GO TO 318 
M = K-i+MA 

NMOVE = -(NKX-K+1) 

CALL MOVE ( 3 , PHI2(K) , PH I 2 ( K+ 1 ) , NMOVE, 1, S2 ( M) , S2 ( M+ 1 ), NMOVE • 1 , 

1 WEZPT(K),WEZPT(K+1), NMOVE, 1) 

NKX = NKX+1 

318 K = K-l 

IF(K.GE.l) GO TO 316 
I F ( NKX .NE .NK ) CALL ERROR 1 

C (BOUNDARY S 1 -TOL E R ANCE ) 

322 T0LS1 = .02*S2(MB )/FLOAT(NK) 

C COMPUTE DEVIATION FROM 90 DEG BETWEEN STREAMLINES ANO ORTHOGONAL 
K =1 

M = MA 




3 25 PHI2(K )=PHI2(K)-(PHUIM)*PIQ2> 
K = K* 1 

M = M + 1 

IF(M-MB) 325,325,328 


C CALCULATE POINT MOVEMENT ALONG STREAMLINES REQD FOR ORTHOGONALITY 
328 0S1<1)= 0. 

CALL LSPF IT ( S2(MA ) , PH I 2 , NK , S2 ( MA ) ,OSI ,NK,-1 ) 

C CORRECT POSSIBLE JOG AT DOUBLE STREAMLINE 

K = l 

M = MA 

3292 IF ( .NOT • WEZPT ( K ) ) GO TO 3294 

K = K + l 

M = M+l 

IF ( . NOT.WEZPT(K)) CALL ERR0R1 
DZ = Z(M)-Z(M-1) 

DR = R(M)-RtM-l) 

CS = C0SIPH1 KM) ) 

SN = SIN(PHIKM)) 

S2MMM 1 = UR*CS-UZ*SN 

IF ( S2MMMI.GE.0, ) GO TO 3293 

Z(M) = Z(M-l) 

R ( M ) = R(M-l) 

S2(M) = S2CM-1) 

DS I ( K ) = DSl(K-l) 

GO TO 3294 

3293 DS I ( K ) = DSI(K-l) - DZ*CS-DK*SN 
S2 ( M ) = S 2 ( M- 1 ) ♦ S2MMM1 

3294 K = K+l 

M = M + l 

IF(M.LE.MB) GO TO 329 2 
I F ( LOOP • EO • 2 ) GO TO 3300 
K = MCLIL ) — MA +1 

ADS 1 = SCX( IC)-SC< IC)-DSl(K) 

IF( TYPELBIL ) .EQ.LL ) ADSi=0. 

IF ( TYPEUBIL ) .LO.LL ) ADS1 =-OSl (NK) 

GO TO 3314 


C PARTIAL OL WITH NO MCL, USL MIDDLE SL, EVAL. 
3300 MSV = l ML B ( L ) *MUB ( L ) ) / 2 
M = MSV 

IK = 65 

IKDIR = -1 

LX = L 

3302 CALL STANOI M, LX , UPPER ) 

X1LIIK)=XKLX) 

SCI IK )= Sl(M) 

VC( IK )= VM( M) 

IF(MCULX).NE.NOMCL) GO TO 3310 
3304 CALL GET 1 X 

IK = IK+IKDIR 

I F ( IKDIR) 3306,3308,3308 
3306 I K A = IK 

I F ( IK.LE.O) CALL ERR0R1 
M = MU 

GO TO 3302 
3308 I KB = IK 

IF! IK. GT. 128) CALL ERROR 1 


PT. MOVEMENT 




33 10 


M = MD 

GO H) 3302 

IF11KUIR.E0.U GO TO 3 312 
IKDIR = 1 
M = MSV 

IK =65 
GO TO 3304 
3312 NIK = I KB- I K A ♦ 1 
VOS ( I KA ) =0. 

CALL LSUMISCI I K A ) , VC ( IKA ) ,NI K , VDSllKA)) 

FVDSK = (Xl(L)-XlL(IKAn/(XlL(IKfl)-XiL(IKAI) *VDSUKB) 
CALL LSPFIHVOSC IKA) , SC ( IKA), NIK, FVDSK,SCK,l, 0) 

K = MSV-MA+ 1 

AO S 1 = SCK-SC ( 6b ) -0S1 (K ) 

C.. END SECTION F OK PARTIAL OL WITH NO MCL 


C CHECK TO SEE IF MAGNITUDE OF DS1 IS REASONABLE 
3314 IF ( ABS( DS1 (NK )) .L T . ( .5*S2 (MB ) )) GO TO 3316 
WRI1E (6,1330) X 1 ( L ) , L ,MA JCTR 
IF ( MAJCTR.LE . 1 ) GO TO 3316 
WRITE (6,1331) 

ERR = .TRUE. 

RETURN 


C DAMP THE 
3316 DO 3318 
DS 1 ( K ) = 
ABSOS 1 = 
DS 1 MX B = 
SOS IS Q = 
NOS 1 = 

DS 1 ( K ) = 
3318 DS 1MX A = 
AOS 1 = 


CALCULATED STREAMWlSE POINT SHIFTS 
K=1 ,NK 
DS1IK )+ADSl 
ABS ( DS 1 ( K ) ) 

AMAXi (DSIMXB.ABSOSI) 

SDS1SQ ♦ ABSDSI*ABSDS1 
NDS 1 ♦ 1 

0S1 (K )*EXP (COEF*ABSDSl> 

AMAX1 ( DS1MXA.ABS (DS1(K) )) 

0 . 


C LOWER AND UPPER BOUNDARY POINT MOVEMENT 
AOS IL B= DS 1 ( 1 ) 

ADS 1UB = -DS 1 ( NK ) 


C MOVE THE LOWER BOUNDARY POINT 
K = 1 

332 GMALB = 0. 

GMAUB = 0. 

M = ML B ( L ) 

CALL GETIX 

I F ( TYPELBIL ) .NE .TE ) GO TO 3332 
ADS 1L B= 0. 

GO TO 3324 

3332 IF ( TYPELBIL ).NE. SOLID .OR. I STAG. EQ. 1 ) GO TO 334 

3324 MA = MLB(L) 

IF(AOSILB) 3325,3325,3326 

3325 IF(MIJ.NE.O) ADS 1L B =AMA X 1 ( ADS 1 LB , . 5* ( SI ( MU ) -SI ( M ) ) ) 

GO TO 3327 

3326 IF(MD.NF.O) ADS 1 L B =AM I N1 l ADS 1 LB , . 5* ( SI I MD ) -SI ( M) )) 

3327 CALL HOYP TM ( N AMEL B ( L ) , I L H ( L ) , Z ( MA ) ,R ( MA ) , F LB { L ) , S 1LB ( L ) , 

1 ADS1LH, GMALB ) 

S 1 ( M A ) = S1(MA)+ADS1LB+ GMALB 

C JUMP OVER RELOCATION OF ANGLE /CURVATURE IF -ITERATION FORMULA ON 



o o 


C BOUNDARY- (ICOB) IS LESS THAN OR EQUAL TO MAJCTR. 

IF(MAJCTR.LE. I COB ) GO TO 333 
PHI 1( HA )=ANGD 
CURV(MA)*CURVD 

333 MA = MA+1 

K = 2 

C MOVE THE UPPER BOUNDARY POINT 

33 4 M *MUB(L) 

CALL GEUX 

IF(TYPEU8(L).NE.TE) GO TO 335 
ADS 1UB = 0. 

GO TO 3352 

335 IF( TYPEUBIL l.NE. SOLID .OR. ISTAG.EQ.I) GO TO 338 

3352 MB = MUB(L) 

IF(ADSIUB) 3355,3355,3356 

3355 IF(MD.NE.O) ADS 1UB=AMAX1 ( ADS 1 UB , . 5* I SI « M ) -SI ( MD) )) 

GO TO 3357 

3356 IF(MU.Ne.O) ADS 1UB=AM I N1 ( ADS IUB , . 5* I S 1 ( H ) -SI ( MU) ) ) 

3357 CALL BDyPTm ( N AMEUB ( L ) , IUB ( L) , 2 ( MB I , R ( MB ) , FUB < L ) , SlUB C L ) » 

1 ADS1UB,GMAUB ) 

S1(MB)= S1(MB)-ADS1UB-GMAUB 
IF(MAJCTR.LE.ICOB) GO TO 336 
PHU(MB) = ANGD-PI 
CURV( MB J=-CURVD 

336 MB = MB- I 

C CHECK FOR NON PRIM STATIONS EXTENDING BEYOUND THE ENDS OF THE BOUND 
3 38 IF < PR IM I L I > GO TO 340 

IF ( (GMALB+GMAUB) .NE.O. ) CALL ERROR I 
GO TO 348 


PRIM STATIONS. IF t I THEM -GET MINUS ASK- VALUE IS LARGE 
CORRECT OTHER BOUNDARY. 

340 I F ( IC.NE.l ) GO To 342 
C (FIRST STATION OF THE REGION) 

GMA = AMAXI (GMALB,-GMAUB) 

GO TO 345 

C (LAST STATION OF THE REGION) 

342 GMA = AM I N l ( GMALB, -GMA UB ) 


345 ADS 1 = ADS1+GMA 

ADS IL B= -GMAUB 
A0S1UB= -GMALB 

I F ( ABS(GMA) .GE.T0LS1 ) GO TO 332 
C THIS IS A DANGEROUS LOOP 


C 


C 


MOVE THE INTERIOR POINTS 
348 M = MA 

350 CALL GET I X 

DS 1 ( K ) = DS 1 ( K ) ♦ ADS I 
I F ( DS 1 ( K ) ) 360,400,380 
(MOVE POINT UPSTREAM) 

360 IF(MU) 361,381,361 

361 OS l ( K ) = AMAXI (0S1(K) ,-.5*(Sl (M)-Si(MU) ) ) 

G = -DSl(K)/t S1(M)-Si (MU) ) 

F = l.-G 

FB = -G 




c 


c 

c 


c 


c 


3 HO 
3 H 1 


383 


390 


Ok = R I M ) - R ( MU ) 

0 / = /(M)-Z(MU) 

Oil I A -■ (MM II MU ) 

PH I it - PH I 1 I M ) 

CURVI M) =CURV(MU )*G ♦ CURV(M)*E 
(,() TO 390 

( M(JV( POINT DOWNSTREAM) 

IF(MD) 381,361,381 

DS1 <K )= AM INK OS 1 (K) , .5* ( SI (MU) -SI (Mil) 

CHECK FOR DOWNSTREAM LEADING EDGE STAGNATION POINT 

THIS LOGIC VALID IF THERE ARE 2 OR MORE OL~S UPSTREAM OF STAG P 

MS V = M 

M = MD 

CALL GETIX 

I S T AGD= ISTAG 

M = MS V 

CALL GETIX 

CHECK FOR JUST ONE PT UPSTREAM OF STAG PT 
I F ( ISTAGD.NE.l ) GO TO 383 
IF(MU.EQ.O) CALL ERR0R1 
GO TO 361 

F = DS1(K)/(S1(MD)-S1 (M) ) 

G = l.-F 

FB = F 

OR = R(MD)-RIM) 

DZ = Z(MD)-ZIM) 

PHIA = PHI l( M) 

PHIB = PHI 1IMD) 

CtJRVI M)=CURV(M)*G ♦ CURV I MO ) *F 
ANGCHD= ATAN3(DR,0Z,PHIA ) 

YPA = PHIA-ANGCHD 
YPB = PHI B-ANGCHD 
CALL BFI 

YQDX = F*G*( G*YPA-F*YPB ) 

ANGM = YPA* ( 3.*G-2. )*G ♦ YPB* ( 3. *F-2 . > *F 
RIM) = RIM) ♦ I FB*DR+YQDX*DZ 1 
ZIM) = Z(M) ♦ 1FB*DZ-Y0DX*DR) 

PHIIIM)=ANGCH0+ANGM 
SUM) = S 1 1 M ) +0S 1 1 K ) 


400 M = M+l 

K = K + l 

IFIM-MB) 350,350,450 


C INDEX TO THE NEXT STATION 
450 IF! IC.GE.NIC) GO TO 470 
L = L+LNEXTIL) 

IC = I C ♦ 1 
GO TO 302 

C LOOP AGAIN THROUGH STATIONS IF THERE ARE PARTIAL OL-S WITH NO MCL-S 
470 1FI .NOT.OLWNCL .OR. L00P.EQ.2) GO TO 500 
LOOP = 2 
GO TO 300 

C CONTINUE TO NEXT REGION 
500 LAST = L 

IFIX2CLID.EQ.BITS) L = L + LNEXT ( L ) 



GO TO 210 


C RMS OF THE REQUESTED DS1-S 

900 DSl RMS= SORT ( SOS ISO/ FLOAT (NDS1) ) 
IF( INRCTR.EQ.O) DS 1RM0=D S 1RMS 
RETURN 


1330 FORMATt /1X44H*** THE ORTHOGONAL LINE ADJUSTMENTS AT ST A*F6. 3. IX3H 
*(L=13»34H) ARE UNREASONABLY LARGE. MAJCTR- 1 3 » 11H. t PTMOVE ) ) 

1331 F0RMAT(6XA0HPLEASE CHECK INPUT BOUNDARY COORDINATES. I 
END 




♦ DECK REFINE 

SIJBROUT I NE RFFINF 

♦REf I NF RtFINF THE (.RIO BY SUBDIVIDING THE INTERVALS -REFINE- 

C INPUI- 

C VMG1 = MAX VELOCITY DIFFERENCE BET GRID POINTS ALONG SL 

C VMG2 = MAX VELOCITY DIFFERENCE BET GRID POINTS ALONG OL 

C Z, R,PhI 1.S1.S2.VM FIELD VALUES (PHI1 IS NOT PRESERVED) 

COMMON /ALLCOM/ M ACHA , PS A , TSA , P TA , T T A , AXI A , RGA, GAMA , 

1 MACHC,PSC,TSC,PTC,TTC, AXI C ,RGC, GAMC ♦ 

2 DA XI T, SCALEA, TTE »CHOTST 

REAL MACHAI 1) f MACHC 

LOGICAL AXIA,AXIC 

LOGICAL CHOTST 

C INDEX- M=MO , NM 

COMMON /CZ / Z ( 300 ) 

COMMON /CR / RI300) 

COMMON /C$2 / S2I300) 

COMMON /CSl / S 1 ( 300 ) 

COMMON / CPH 1 1 / PHIK300) 

COMMON /CM / J MS ( 300 ) 

COMMON /CCURV / CURV ( 300 ) 

COMMON /CB / BI 300) 

COMMON /CIDEX / M, J,MU,MD,ISTAG 

COMMON /IXORIG/ LHO.LHE, LBDQ,LBDE » LTO,LTE* LWO.LWE* LFO,LFE, 

* LO »LESTA * LDUMI8), 

* MO » NM v NJ.NFCOLS, MAXN J , MAXOL .MAXNM » MAXLE » 

* LEO* LEE t LRO,LRE,LRD 

DIMENSION LIMITSI2A) 

EQUIVALENCE (LIMITS, LHO) 

COMMON / SL TAB / W ( 12 8 ) , X 2 ( 128 ) , SLCHN ( 1 2 8 ) 

INTEGER SLChN 
C STATION TABLE 

C INDEX- L=LO,LESTA 

C SCHOK E= STATION CHOKE INDICATOR ( ADJWF »BRHS,WRIOUT » 

c mcl = sharp corner indicator (Bldtbs) 

C mcl = FIELD INDEX OF CONTROL STREAMLINE I PTMOVE ,FLOBAL ) 

COMMON /CHDATA/ XI ( 1 ) * LNE XT(1) ,MLB(1 ) ,MUB( 1) fPRIMIl ) , 
l TYPE LB ( I ) tNAMEL B ( 1 ) * ILBII) ,FLB ( 1 ) , S 1L B ( I ) , 

1 TYPEUH ( 1 ) *NAMEUB ( 1 ) , IUB( I) * FUB ( I ) ,SIUB( I ) , 

3 VMB( 1 ) *DWDV( 1 ) , X2CL(1) ,VCL(1) *MCL(A81) 

LOGICAL PRIM 

INTEGER T YPELB » T YPEUB 
DIMENSION SCHOKE(I) 

EQUIVALENCE ( SCHOKE , DWDV ) 

DIMENSION IPRIM(l) 

EQUIVALENCE (IPRIM*PRIM) 

COMMON /CBITS / BITS, BLANK 

COMMON /CCRX / CRXSL,CRXOL,CRXSS,CRXE,CRXC,CRMACH 
C CRXSL = NEW SL EXTENSION CRITERIA 

C CRXSS = EXTENSION CRITERIA FOR NEW OL IN REGION WITH SOME SS-FLOW 

C CRXOL = NEW OL EXTENSION CRITERIA 

C CRXE = EXTENSION CRITERIA FOR NEW OL WHICH CROSSES SONIC LINE 

C CRXC * EXTENSION CRITERIA FOR NEW OL WHICH CROSSES SHOCK WAVE 

C C RM AC H = UPPER MACH NUMBER LIMIT FOR OL EXTENSION 

COMMUN /CMAXIT/ MA XI T , MA JCTR , GR EF I N , EDUM 



ooooo oooo 


LOGICAL GREFIN 

COMMON /CPRINT/ PDUM1 ( 3 ) , PREF IN »PREFN2 , SSONIC *PDUMl 10 ) 

LOGICAL PRTDB 

COMMON /CREFLE/ R L E 1 ,RLE 2 ,RLE 3 , HLE 
COMMON /CREFIN/SLS,SG21, VMG1,VMG2 

It NGRtNGZ, SGR ( 10 ) » GR ( 10 ) » SGZ 1 10) , GZ ( 10 ) 

COMMON /CTABPR/ 1 1 TAB 

COMMON /CTOLRL/ T OLR L ( L2 ) # SG I RE F , TOL I NR 
COMMON /CVM / VMI300I 

COMMON /ERASE 2/ CR 1 128 ) , DELS ( 128 > , DE L VM( 128 ) , LSTA ( 128 ) , MJ2 < 128 ) , 
l SGX( 128) ySGYI 128) ,RAV(128),ZAV(128)« I A ( 16 ) , I B ( 16 ) 

INTEGER EXT, FIELD, HINT, HLE, TE 

LOGICAL DOWNB , EXTND1 , EXTND2 *HALVE »NEWSL» SSP* UPPER 

NAMELIST /NL2/ L l , L2 , MAI , MB 1 ,MA01 , MBD1 , MA2 * MB2 , M AU2 « MBU2 
NAMELIST /NL 390 / S 1 A , S IB , S2A , S2 B , S 1 A2 , DOWNB 
NAMELIST /NL 3/ X l NE W , 00 WNB , L ,L 3 , NPT S 

DATA F I ELD/5HFI ELD/ 

GRE F I N= .FALSE. 

0VMG1 = 1./VMG1 
QVMG2 = 1./VMG2 

I F ( PDUM ( 7I.NE.0. > CALL TABPRT (6HRFN-VM,VM,NM,NJ) 

CHECK TO SEE IF PARTIAL OL SHOULD BE EXTENDED 
CHECK TO SEE IF PARTIAL SL SHOULD BE EXTENDED 
OMIT 


*** EXAMINE GRID INCREMENT BETWEEN ORTHOGONALS 
300 LI = LO 
NAVG = 0 
SGI AVG= 0. 

SG i M I N= 1.E6 
SGMX = 0. 

SGMX2 = 0. 


CHECK FOR ADJACENT STATIONS AND DETERMINE THE BASE STATION - 
A BASE STATION IS THE OL UPSTREAM OF LE STAG PT , 

DOWNSTREAM OF A TE, OR THE SHORTEST OF I PART I AL 1 OL-S. 

OTHERWISE THE BASE STATION CAN BE EITHER THE UPSTREAM OR DOWNSTRE 
DOWNB = DOWNSTREAM BASE STATION 
305 L2 = L 1+LNEXT (LI) 

IF(L2 .GE.LESTA) GO TO 99 
MAI = MLB(Ll) 

M = MAI 

CALL GET I X 


MAD 1 = MO 

MB 1 = MUB (LI) 

M = MB1 

CALL GETIX 



MBD1 = MD 
MA2 = MLB ( L 2 ) 
M = MA2 

CALL GETIX 


MAU2 = MU 
MB 2 = MUB ( L 2 I 

M = MB2 



o o o o o o 


CALL 0 E T I X 
MBU2 = MU 
PRTOB = .FALSE. 

IF (PREFN2.E0. 1 . .OR. ( PR t F n 2 .GE . X 1 ( L2 > . AND .X 1 1 L 1 > .GE . PDUM (8) 
1 .AND. { PKEFN?*PtJIJM( H) » .GT.U. ) ) PRTDB*. TRUE • 

I F ( .NUT . P R f U H ) GO TO 312 

CALL TABPRH 6HSTA-L 1 . XI (Ll ) ♦ 1 , 1) 

WRITL (6.NL2I 
312 CONTINUE 

C ADJACENT STATION TEST 

IF ( (MA2.LE.MAD1 .AND. MAD1.LT.MB2) .OR. 

1 (MA2.LT. MBD1 .AND. MBD1.LE.MB2) .OR. 

2 (MAl.LE.MAU2 .AND. MA U2. L T .MB 1 ) ) GO TO 330 

C CHECK FOR TE FOLLOWED BY Lt 

DATA TE/2HTE/ 

IF ( MAJCTR.GE.l ) GO TO 550 
IF ( TYPELB(LI) .N6.TE ) GO TU 322 
M = MAI 

GO TO 324 

322 IF(TYPEUB(L1).NE.TEI GO TU 550 

M = MB 1 

324 CALL GETIX 

CALL STAXl(Xl(Ll) f X2(J),X2(J),LXB,LXA) 

LXB.LXA ARE STATIONS BELOW AND ABOVE THE TRAILING EDGE. 

IF L 2 IS A LEADING EDGE STATION FOLLOWING Ll* THEN Ll MUST 
BE THE SECOND OF THE TWO TE STATIONS. 

IF (Ll.EQ.LXA .OR. Ll.EO.LXB) GO TO 325 
WRITE ( 6 * NL2 ) 

CALL ERROR 1 

325 IF ( LXH.GT .Ll .OR. LXA.GT.L1) GO TO 550 

INSERT AN ORTHOGONAL BETWEfc N THE TRAILING EDGE AND 
LEADING EDGE STATIONS. 

DEFINE MJ2( I)*CR( I )*NI* DOWNB, L*L3 
1=0 
M = MLH(LXH) 

326 I = 1*1 

M J 2 ( I )= M 
CR ( I ) = 2. 

M = M* 1 

IFIM.LE.MUB(LXB)) GO TO 326 
M = MLB(LXA) 

327 I = I+l 

MJ 2 ( I ) = M 
CR ( 1 ) = 2. 

M = M+ 1 

IF (M.LE.MUB( LXA ) ) GO TO 327 
N I = I 
DOWNB = .FALSE. 

L = Ll 

L 3 = L2 

GO TO 440 

C NUMBER OF PRIMARY STATIONS 
330 NPRIM = 0 

I F ( PRIM(L1).0R.PRIM(L2) ) NPRlM=l 



I F ( PRIM(L1).AND.PRIM(L2 ) ) NPRIM=2 
LBASE = LI 

IF(NPRIM-l) 340t 350* 360 
C NO PRIM STATIONS 

340 IFIMAU2.GT.MAl .OR. MBU2.LT.M81) GO TO 380 
GO TO 370 

C ONE PRIM STATION 

350 IFIPRIM(LD) GO TO 380 
GO TO 370 

C BOTH LI AND L 2 ARE PRIM STATIONS 

360 I F ( ( MB2-MA2 ).GT.(MB1-MA1)) GO TO 380 

C UPSTREAM BASE STATION 

370 DOWNS * .FALSE. 

MA * MAI 

MB = MB 1 

L * LI 

L 3 = L 2 

GO TO 390 

C DOWNSTREAM BASE STATION 

380 DOWNB= .TRUE. 

MA = MA2 

MB = MB2 

L = L 2 

L3 = LI 


CHECK L.E. REFINEMENT 
390 IF(TYPELB(L3).NE.HLE 


CRITERIA 

.AND. TYPEUB(L3).NE.HLE> 


GO TO 395 


394 


NEW ORTHOGONAL IN FRONT OF L.E. 

IF(DOWNB) GO TO 394 
MX = MBU2 

IF( TYPELB(L3).E0.HLE ) MX=MAU2“1 
S2B = S2 ( MX I — S 2 ( MX-1 ) 

S2 A = S2(MX+2)-S2(MX+l) 

M = MX-1 

CALL GET I X 
SIB = Sl(MD)-SKM) 

M = MX + 2 

CALL GET I X 
S 1 A = Sl(MD)-SllM) 

IF( PREFN2.NE.0. ) WRITE (6.NL390) 

I F C (SIA.LE.RLE1*S2A .OR. SIB. LE .RLE1 *S2B ) 

1 GO TO 550 
GO TO 400 

NEW ORTHOGONAL BEHIND L.E. 

M = MB 1- l 

IF ( TYPELB(L3I .EQ.HLt > M-MAU1 

CALL GET I X 

S1A2 = SKMD)-Sl(M) 

DR = R(M)-R(MU) 

DZ = Z (M J-Z ( MU ) 

S 1 A = SORT ( DZ*DZ+DR*DR ) 

IF( PREFN2.NE.0. ) WRITE (6.NL390) 

IF( S1A2.LE.RLE2*S1A .AND. MAJCTR.GE.l) GO TO 550 
GO TO 400 


AND. MAJCTR.GE.l) 
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C I NM I h I I HCriNEMINT AROUND A FIXED STAGNATION POINT 
395 M = ML 14 ( l 31 

CALL GF 1 IX 

IMI5IAG.NE.il GO TO 3 99 
IF(DOWNB) GO TO 397 

C NL w UL IN FRONT OF STAG PT UN LOWER BDY 

S?A = S 2 ( MAU2*1)-S2<MAU2> 

M = MAU2+1 

3 96 CALL GET IX 

S 1 A = SICMDI-SIIM) 

I F ( S1A.LE.RLE1*S2A .AND. MAJCTR.GE.I) GO TO 550 
GO TO A 00 

C NEw UL BEHIND STAG PT ON LOWER BDY 

397 M = M A 1 ♦ 1 

39b CALL GET IX 

S1A2 = SKMOI-SKM) 

DR = RIM)-R(MU) 

07 = Z CM ) — 2 I MU ) 

S I A ^ SORT lDZ*M + nR*OR > 

IF( S1A2.LE.RLE2*S1A .AND. MAJCTR.GE.I) GO TO 550 
GO TO 400 

C NEW OL IN FRONT OF STAG PT ON UPPER BDY 

399 M = MUBIL3) 

CALL GETIX 

IF( ISTAG.NE.I ) GO TO 400 

IF(DOWNB) GO TO 3992 

S2A = S2IMBU2 )-S2< MBU2-1) 

M = MBU2-I 

GO TO 396 

C NEW OL BEHIND STAG PT ON UPPER BDY 

3992 M = MB1-1 

GO TO 398 


C** SWEEP ACROSS THE STREAMLINES TO CHECK FOR REQD GRID REFINEMENT 
C BETWEEN ORTHOGONALS Ll AND L2 

400 X 1 L 3 * X l ( L 3 ) 

LX = L 1 
I = 0 


420 


M = MA 

CRXL * CRXOL 

SSP = .FALSE. 

CALL GETIX 
MX = MD 

IF(DOWNB) MX=MU 
IF(MX.EQ.O) GO TO 430 
CALL STANO(MX,LX,DUM ) 

I F ( XI ILX) .NE.XIL3) GO TO 430 


I =1 + 1 

DELS! I ) = ABSISHMXI-S1IH) ) 
CALC LARGEST, NEXT LARGEST 
FOR DETERMINING NUMBER OF 
IF (MAJCTR.GE.I ) GO TU 425 
IF (DELS! I ) .LT.SGMX) GO TO 
SGMX2 = SGMX 
SGM X = DELS ( I ) 

GO TO 425 


DISTANCES BETWEEN ORTHOGONALS, 
EXTRA SL-S 

42 3 



SGMX , S 


423 I F ( DEL S ( I) .GE.SGMX2) SGMX2=DELS( I ) 

C MINIMUM DISTANCE BETWEEN ORTHOGONALS 

425 SG1MIN« AMIN1 ( SGlMINt DELS ( I )) 

C AVERAGE DISTANCE BETWEEN ORTHOGONALS 

SGIAVG- SGI AVG+DEL S ( I ) 

NAVG = NAVG+l 

DEL VM ( I )*ABSIVM(MX>-VM(M) »*QVMG1 
RAV(II= . 5* ( R (MX I +R ( M ) ) 

2AV( I .5*<Z(MX)*Z(M) ) 

MJ2( II* M 

C CHECK FOR SUPERSONIC FLOW 

I F ( B( M ) .LT .0. .OR. BIMXI.LT.O.I SSP-.TRUE. 

C COMPUTE ORIENTATION OF SONIC LINE 

I F ( PR TDB I WR I TE ( 6 1 1426 ) M ,MX , B ( M > » B { MX I 

1426 FORMAT ( 24H RE F I NE -M ,MX ,B I MJ , B ( MX ) -2 16 ,2F 10. 3 ) 

IF ( M. EQ.MA ) GO TO 430 

BM = B ( M ) 

BMM1 = B(M-l) 

IFIM.NE.IMA + l ) .OR. B ( MX- 1 ) *BMM 1 . GE . 0 . ) GO TO 4258 
F = 0. 

BMM1 = B ( MX— 1 ) 

GO TO 4260 

4258 IF ( M.NE .MB .OR. B ( MX ) *BM . GE .0 . I GO TO 4259 

F = 1 . 

BM = B ( MX ) 

4259 I F ( BM*BMM 1 . GT .0 ■ ) GO TO 430 

F = BMM1/IBMM1-BM) 

4260 FX = 0. 

4261 I F ( B( MX )*BM.GE.O. ) GO TO 4262 

FX = FX+1. 

IF ( MX .GE .MUB( L3 ) ) GO TO 4265 
MX = MX+1 

GO TO 4261 

4262 IF(B(MX-1 )*BMM 1 . GE .0 . ) GO TO 4264 

FX = FX-i. 

IF( (MX-1 ) .LE.MLB(L3)J GO TO 4265 
MX = MX-1 

GO TO 4262 

4264 FX = B(MX-l)/IB(MX— D — BfMXI) ♦ FX 

4265 FX = FX-F 

IF(PRTDB) WRITEI6, 1427) MX,F,FX 

1427 FORMAT ( 9H MX , F , FX- I 6 , 2F 1 0 . 3 ) 

IF(DOWNB) FX=-FX 

C FX SLOPE OF SONIC LINE IN TERMS OF GRID INTERVALS 

C CHECK FOR EXPANSION OR COMPRESSION 

IF(BM*FX.LT.O. ) GO TO 4266 
C EXPANSION 

CRXL * AMINltCRXLtCRXE) 

FX = ABS!FX)*SLS 

I F ( FX • GE • • 75 ) DEL SI I ) =AMAX1 ( DEL S (I) t ( S2 1 M) -S2 (M-IM/SG21) 
OELVMI I )=AMAX 1 ( OELVMI I ) , 10.* ( FX-1 . )) 

C COMPRESSION 

4266 CRXL * AM INI (CRXL»CRXC) 

430 M = M+l 

IF(M.LE.MB) GO TO 420 
IFICRXSS.LE.CRXL .AND. SSP) CRXL*CRXSS 
N I = I 

CALL LFITlIGRf SGRtNGR* RA V* SGY» NI ) 



r.Atl LF IT1I(,Z ,SG7 ,NG/, Z A V , SGX , N I ) 

HAL VE = . f AL S F . 

on 4 1 / I - 1 , N I 

RS = DLLS! I ) /AMAX 1 I SGX II) ,SGYI I ) ) 

CR ( I ) = RS ♦ DE L VM ( I )*R j**.2 

43/ IF ( CM ( 1 > .GT . 1 . ) HALVf=.TRU6. 

I F ( . NUT . PKTDB ) GU TO 435 
CALL TABPR r I 3HMJ2,MJ2,NI , 10) 

CALI TABPRTI 3HRAV,RAV,NI , 10 ) 

CALL TABPRTI 3HZAV,ZAV,NI ,10) 

CALI TABPRTI 3HSGX, SGX, NI ,10) 

CALI. TABPRTI 3HSGY,SGY,NI ,10) 

CALI TABPRTI 4HDELS, DELS, N I, 10) 

CALL TABPRTI 5H0E L VM , fj EL VM , N I ,10) 

CALL T ABPRT I 2HCR , CR ,N I , 10) 

43b CONTINUE 

C PREVENT TOO RAPID CHANGE IN OL SPACING 
IFIHALVE) GO TO 440 
X 1 D 1 2 = .5*1X1(12 ) -X 1 1 L 1 ) ) 

IF! PR I M I L 1 ) ) GO TO 436 

IF((X1(L1)-X1(L1M)).LT.X1U12) HAL VE= • TRUE . 

GO TO 437 

436 L 1 M = LI 

437 IF( PRIMIL2) ) GO TU 438 
L2P = L2+LNEXTIL2) 

IF! IXlIL2P)-Xl(L2) ).LT . X 1D12 ) HALVE*. TRUE. 

GO TO 439 

438 L2P = L 2 

439 IF! .NOT. HALVE ) GO TO 550 

IF I TYPELBIL 1 ) .EO.F IELO .OR. TYPELBILIRI.EO. FIELD .OR. 

* TYPELBIL2 ) .EO.F IELU .OR. T YPELB I L2 P ) . EQ. F I ELD ) GO TO 4391 
CR( 1 ) = l . 

GO TO 440 
4391 CRINI ) = l. 

C** ADD A NEW ORTHOGONAL LINE BETWEEN Ll AND L2, FIRST CHECK MEMORY 

440 XINEW = . 5* I X 1 1 L 1 ) *X 1 1 L2 ) ) 

EXTND 1 = .TRUE. 

EXTND2* .TRUE. 

IF! TYPELBIL). EQ. FIELD) E X TND 1 = . F AL SE . 

IF! TYPEUBIL ) .EQ.F I ELD) E X TND2 = . F AL SE . 

IRET = 0 

IF! (LESTA + 20) .LE.MAXLE ) GO TU 800 
WRITE 16,1440) XINEW 

1440 FORMAT I 1X72H*** STATION TABLE STORAGE LIMIT DOES NOT ALLOW A NEW 

♦ ORTHOGONAL AT X I 1 = F7 . 3 , 1H ./6X61HGR I D REFINEMENT BY INSERTING ORTHO 
♦GONALS IS BEING TERMINATED.) 

GO TO 99 

450 IFINL.EO.l) GO TO 455 

WRITE (6,1450) NL, XINEW 

1450 F0RMATI/3X, I2,1X17H0L-S REQUESTED ATF8.3,) 

IB(l) = IBINL ) 

NL = 1 

C** ADJUST FIELD ARRAYS FOR THE NEW OL 
455 NPTS * IBI 1 )-I AI 1 )+ 1 

GRE F I N= .TRUE. /" 7^ 
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IF(PRTOB) WR I TE ( 6 »NL3 ) 

CALL ADDFPT(MA2«NPTSt999999) 

C CORRECT THE POINTERS IN THE JMS-TABLE 
MNEW = MA2 
HA = MNEW 
I * IAtl) 

460 IF(DOWNB) GO TO 470 

(UPSTREAM BASE STATION) 

UPSTREM POINT 
M = MJ2 < 1 ) 

CALL GETIX 
MDSAV = MD 
MD = MNEW 
CALL SAVIX 

C NEW POINT 

MU = M 
M = MNEW 

MD = MDSAV 
l STAG = 0 
CALL SAVIX 

C DOWNSTREAM POINT 

M * MD 

CALL GETIX 
MU = MNEW 

CALL SAVIX 
GO TO 490 

C (DOWNSTREAM BASE STATION) 

C DOWNSTREAM POINT 

470 M = M J 2 ( I ) ♦NPT S 

CALL GETIX 
MUSAV = MU 
MU = MNEW 
CALL SAVIX 

C NEW POINT 

MD = M 
M = MNEW 

MU * MUSAV 
ISTAG = 0 
CALL SAVIX 

C UPSTREAM POINT 

M = MU 

CALL GETIX 
MD = MNEW 
CALL SAVIX 

490 I = 1+1 

MNEW = MNEW+1 
IF(IB(1)-I) 495»460t460 
495 MB = MNEW-1 

IF(PRTDB) CALL JMSPRT 

C** MODIFY STATION-TABLE 

500 CALL INSTA(L2*L »L3 tDOWNB » MA,MB) 

C INCREMENT TO THE NEXT ORTHOGONAL INTERVAL 



*>‘.0 1. 1 M = LI 

LI = L? 

GO If J 305 

C AVERAGE GIST BET OKTHUGS 
04 S G l A V G = SG1AVG/FL0AT (NAVG ) 
SGlH( f = .5*( SG1MIN*SG1AVG > 


C*** EXAM INF GRID INCREMENT ABOVE STREAMLINE J2 , <J2=l,NJ) 

J? = 1 

IE ( PREFN2.E0.0. ) GO TO 100 
I1TAB = LO 

CALL TABPRT ( 6H560STA , XI , LEST A, 5) 

100 J2NEX T = J 2* 1 

IF(W( J2 + U.E0.0.) GO TO 200 

C N E X T R A = NO OF EXTRA SL-S NEAR THE BODY FOR CHN= EXT , I NT 


C 


C 


C 


C 

c 


NE X TR A = 0 

DATA EXT/3 HE XT/, HINT /3HINT/ 

IF (MAJCTR.GT.O .OR. ( SLCHNI J2) .NE .EXT .AND. SLCHN ( J2 ) .NE .HINT )) 
1 GO TO 104 

M = MB EG IN ( J2 ) 

DSOL = SGMX2/2. 

RROL = (RIM+1J-RIM) ) /DSOL 

IF ( A X I A ) RROL= (R( M+l )*R(M+1)-R(M) ♦R(M) ) / (DSOL * ( R ( M ) ♦DSOL ) ) 

RK = 0. 

1F(R(M).LE..I) GO TO 101 

THfc FIRST SL IS TO BE PLACED ABOUT ONE BODY RADIUS AWAY 
RR AT 10= R(M+l)/R(M) 

RR = RR AT 10— 1 . 

IF ( AXIA) RR=(RRATIO*RRATIO-1. )/3. 

101 RR = AMAX 1 ( RR , RROL ) 

NE X TR A= MAXO ( 1 , M I NO < I N T ( ALOG < RR ) / ALOG ( 2 . ) ) -1 1 B ) ) 

N E X T R A = MAXO ( 1 , IN T ( ALOGIRR )/AL0G<2. ) ) > 

104 M = MBEGINU2) 

M = THE FIRST POINT ON THE STREAMLINE 

C X T ND 1 = .TRUE. 

EX TNI)2= .TRUE. 

L =0 

WMIN = l . E6 
I = l 

IIO CALL GETIX 
MNEXT = MD 

CALL STAN0(M,L, UPPER ) 

BYPASS UPPER BOUNDARY OF PARTIAL OL 
IF(UPPER) GO TO 120 
CHECK L.E. REFINEMENT CRITERIA 
IF( ISTAG.NE.1) GO TO 114 
S 2 A = S2 I MU+ 1 ) — S 2 I MU) 

02 = Z(M*1)-Z(MU*1) 

DR = R( M+l )-R ( MU+1 ) 

S 1 A = SORT (DZ*DZ*DR*DR ) 

DZ = Z(MD+i)-Z(M+i) 

DR = R ( MD + 1 ) -R ( M ♦ 1 ) 

S1A2 = SORT (DZ*OZ + UR*DK ) 

IF (( S2A.LT. RLE3*S1A .OR. S2 A .L T . RLE 3*Si A2 ) .AND. MAJCTR.GE.l) 


1 GO TO 200 
1 14 LSTA( I ) =L 
MJ2 ( I 1= M 




DELS! 1 >=S2(M+1)-S2(M) 

C I N0TE-S2 IS NOT UPOATED IF THIS IS FOR AN EXTRA SU 

DEL VM ( I ) = ABS(VM(M«-1)-VM(M) )*QVMG2 
ZAV(I)= .5* ( Z ( M*1 ) +Z (M ) ) 

RAVI I )= .5*(RIHni+R|H)l 
M = M + I 

CALL GETIX 

IFU.EQ.l .AND. MU.NE.O) 6XTND1 *.F ALSE • 

IFIMNEXT.EO.O .AND. MD.NE.O) EX TND2*. FALSE . 

C CHECK L.E. REFINEMENT CRITERIA 

I F ( I STAG.NE • l ) GO TO 117 
S2B = S2(MU)-S2(MU-1) 

DZ - ZIMU-l )-Z(M-i) 

DR = RIMU-i I-RIM-1I 

SIB = SORT I DZ*DZ + DR*DR I 
DZ = Z(MD-l)-ZIM-l) 

DR = RIMD-1 )-R(M-l) 

S1B2 * SQRT(DZ*DZ*DR*DR ) 

I F ( ( S2B.LT.RLE3*SlB .OR. S2B.LT.RLE3*S1B2 ) .AND. MAJCTR.GE. 1 I 
1 GO TO 200 


117 IFIWI JJ.GE.WMIN) GO TO 119 
WM IN = WIJ) 

X2MIN = X2IJJ 

119 I = I+l 

120 M = MNEXT 

IF(M.NE.O) GO TO 110 
n i = i-i 


CALL LFITlIGRfSGRt NGR » RAV,SGY,NI> 

CALL LFlTlIGZtSGZfNGZ* ZAV,SGX,NI) 

C CR C 11=1 IS THE RADIUS OF PERMISSIBLE GRID SIZE 

HALVE = .FALSE. 

DO 132 I*1,NI 

RS = ABSIDELSI I ))/(AMAXi( SGXin tSGYIII )*SG21» 

CR(I) * RS ♦ DELVMI II*RS**.2 
IF(CR( I l.GT.i.) HALVE*. TRUE. 

132 CONTINUE 

C*** IF HALVE=T ADD NEW SL FOR STATIONS FOR WHICH CR.GT.5 
PRTDB = .FALSE. 

IFIPREFIN.EO.l. .or. IPREFIN.GT.X2I J2 ) . AND. X2 < J2 ) .GE .PDUM( 8 ))) 
1 PR TDB= • TRUE • 

IF I .NOT. PRTDB) GO TO 141 
CALL T ABPRT ( 2HCR »CR»NI*10,0) 

CALL T ABPRT ( 3HMJ2*MJ2»NI » 10»0) 

CALL T ABPRT ( 4HLSTA «LSTAf N I t 10 V 0 ) 

141 CONTINUE 

IFI .NOT. HALVE ) GO TO 200 
IRET = -1 
CRXL = CRXSL 
GO TO 000 

145 WNEW = .5*1 W( J2I+WMIN) 

X 1 2 = .5*1X21 J2 J+X2MIN) 

IF I PRTDB ) CALL TABPRT ( 4HWNE W,WNE W , 1 , 1 ) 

C BEGIN LOOP FOR INSERTING THE (PARTIAL) STREAMLINE t LI*ltNL 
LI =1 
NPT ADD= 0 
150 II - I A ( L I ) 



12 = I R < L I ) 

I F < I 1 . EO.O) GO TO 195. 

t Dill. KM INF Jl, 1NDCX OF NEW SL 
J = J2 

160 IF (W(J).GT.WNEW) GO TO 170 
J = J*1 

IF1J.GT.NJ) CALL ERROR I 
GO TO 160 
170 Jl * J 


C 

C 

c 


ADJUST FIELD ARRAYS ANO SL TABLES 
NEWSL = .TRUE. 

I - I l 

MU 1 = 0 

IFINJ.LT. MAXNJ) GO TO 180 
WRITE (6,1175) X 1 2 
RETURN 

180 L = LSTAl I ) 

Ml = MJ2< I J+NPTAOD+l 

MO 1 =0 

CALL ADPTSL (Ml ,MU1 ,MD1 ,J 1 .NEWSL ) 

NPT ADD* NPT ADD* 1 
M = M 1 + 1 

CALL GETIX 
JP = J 
M = Ml-1 

CALL GETIX 
JM » J 

M = Ml 

J = Jl 

W(J) = WNEW 
X 2 ( J ) = X I 2 

F = ( W(JP )-WNEW)/(Wl JP)-W(JM) ) 

ONEMF = l.-F 
M = Ml 

B ( M ) = B ( M- 1 ) *F ♦ B ( M+ 1 ) +ONEMF 

RIM) = R ( M- 1 ) * F ♦ R(M + l)*ONEMF 

IF(AXIA) R(M)=S0RT(R(M-1)*R(M-1)*F ♦ R 1 M* 1 ) *R ( M+ 1 ) *ONEMF ) 

Si(M) = S 1 ( M- 1 ) + F ♦ Si (M*1)*0NEMF 
VM ( M I = VM ( M- 1 ) * F ♦ VM ( M* 1 )* ONEMF 
Z ( M ) = Z ( M- 1 ) * F ♦ Z(M+1)*0NEMF 

SET I STAG = 3 FOR PTS ADJACENT TO L.E. AND BOUNOARY CORNER PTS. 

I F ( . NOT . PR I M ( L ) ) GO FO 185 


181 

182 


M = Ml-1 

CALL GETIX 
ISTAGM= ISTAG 
M = Ml + l 

CALL GETIX 

IF ( I STAGM.EO.l ) GO TO 18 1 
IF ( I STAG. NE. 1 ) GO TO 185 
( I S T AGP = 1 ) 


1ST AGM = 0 
GO TO 182 
( I SI AGM =1 ) 
I STAC, « 0 



CALL SAVIX 


M = Ml 


* 



noon 


CALL GET IX 
ISTAG * 3 
CALL SAVIX 
M = Ml-1 

CALL GET I X 
ISTAG = ISTAGM 
CALL SAVIX 

C UPDATE THE STATION-TABLE POINTERS TO THE FIELD-TABLE 
185 CALL STTOF 1 ( L » l ) 

GREFIN* .TRUE. 

C INOEX TO NEXT PT ON SL 
NEWSL * .FALSE. 

190 I = 1*1 

HU 1 = Ml 

I F ( 1 2- I ) 194,180,180 

C INOEX TO NEXT PARTIAL SL 

194 J2NEX T= J2NEXT+1 

195 LI = L I ♦ 1 

IF( .NOT.PRTDB) GO TO 197 
1 1 TAB = LO 

CALL TABPRT(6H195STA,X1,LESTA,5> 

CALL JMSPRT 
197 CONTINUE 

IF(NL-LI) 200,150,150 

C LOOP TO PUT IN ADDITIONAL SL-S FOR EXTERNAL CHANNELS 

200 IF(NEXTRA.EO.O) GO TO 210 
NEXTRA= NEXTRA-l 
GO TO 104 

C INCREMENT THE STREAMLINE COUNTER J2 
210 J2 = J2NEXT 

IFIJ2.LT.NJ) GO TO 100 
RETURN 


*** EVALUATION OF NEW LINE POSITIONS 
OUTPUT- 

NL NEW LINES ARE TO BE IN THE REGIONS IA(LI) TO IBILII, LI*1«NL 
FOR IAILD.NE.O. 

C SEARCH FOR CR.GT.l. POINT 
800 NL =0 
I = 1 

805 IFICRI II.GE.l. ) GO TO 810 
I *1+1 

I F ( I.LE.NI) GO TO 805 
GO TO 840 

C FIND I A , I B SO THAI CR.GE.. 375 IS WITHIN IA,IB 
810 NL = MINOI NL+i , 10 ) 

ISAVE = I 
815 I A ( NL ) = I 
I = 1-1 

IFII.GE.1 .AND. ( I.GE.(ISAVE-3).0R.CR(n.GE.CRXLn GO TO 815 




I = 1 S A V I 

8 20 IIWNI ) = I 

I -Ml 

1 f ( I . G T . N 1 ) GO Tl) 840 
I ( ( (,H ( I > .CL . 1 . ) 1 SAVE = I 

If ( I . l t . ( I 5 A V E ♦ i ) .f)K. CK ( I) .(,E .CRXL ) GO TO 820 

C REPEAT THt ABOVE FOR THE NEXT PARTIAL LINE 
IF( I .LT.NI ) GO TO 805 

C ADO ONLY ONE LINE IF NL.EQ.10 
840 IF(NL.NE.IO) GO TO 850 
NL = 1 
IBll) = I B I 10 ) 

C ELIMINATE THE SHORI GAPS BETWEEN LINES 
850 IF(NL.LE.l) GO TO 860 
LJ.LA.SX® 1- 

00 855 L I = 2 »NL 

IF( ( I A(L I )- I B ( L I- 1 ) ) .GT.7) GO TO 854 
IBILI — I)=IBILI ) 

1 A ( L I )= 0 
GO TO 855 

854 L IL AST= LI 

855 CONTINUE 

NL = LILAST 

860 IF! 1 A ( IJ.LE.2 .AND. EXTN01) IA(1)=1 

IF( (Nl-IR(NL) ) • L F. • 2 .AND. EXTN02) IB(NL)*NI 

C EXTEND EACH LINE TO A MINIMUM OF FIVE POINTS 
NPTS = 0 
DO 870 L I = l »NL 
I F I I A ( L I I.EO.O) GO TO 870 
865 I DEF = MAXO( (5-( IBILI )-IA(LI )))/2t 0) 

I A ( L I ) = MAXOI IAILI I-IDEF, I) 

IBILI ) = MINOI IBILI )+IDEF,NI J 
NPTS = NPTS ♦ IBl LIJ-IA ( LI ) +1 
IFINPTS.LT. 5 .AND. NPTS. LT.NI) GO TO 865 
870 CONTINUE 

IFIPRTDB) WRITE 16, 1880) I I A I L I ) . I B I L I ) t L I =1 , NL ) 

1880 FORMA I I 7H I A, IB = , 101 4X , 2 I 4 ) ) 

IF! (NM+NPTSJ.LE.MAXNM) GO TO 890 

WRITE (6,1881) NM.MAXNM 

RETURN 

C RETURN 

890 1FIIRET) 145,450,450 

1175 FORMAT I /2X36H*** STREAMLINE LIMIT REACHEO. ( X 12 = F6 . 3 , 1 H ) ) 

1881 FORMAT I /2X69H*** FIELD POINT STORAGE LIMIT PREVENTS FURTHER GRID R 
REFINEMENT. (NM=I4,8H, M A XNM= 14 , 1H ) ) 

END 


♦DECK REFBLK 

BLOCK DATA REFBLK 

♦REFBLK BLOCK DATA FOR REFINE 

COMMON /CREFLE/ RL El ,RLE 2 ,RLE3, HLE 

DATA RLEl,RLE2,RLE3/.65 # 1.3, 1.3/, HLE/2HLE/ 

END 


-R6F8LK- 


/ 
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♦ DECK SLC 

SUBROUTINE SIC 

♦SLC STREAMLINE CURVATURE ETC -SLC- 

C****CALCULATF ANGLE, CURVATURE AND ARC LENGTH ALONG STREAMLINES 


INPUT- 

H = SUBSONIC SUPER SUN IC INDICATOR, NEGATIVE FOR SUPERSONIC VEL 

Z,K = STREAMLINE COORDINATES 


OUTPUT- 

PHII = ANGLE IN RADIANS 
CUR V = CURVATURE 
SI * ARC LENGTH 


COMMON /CBE AM 2/ 


LOGICAL 
COMMON /CSS 


1 


INTEGER 
LOGICAL 
SSFML = 
SSEF = 
SSE ANG= 
SSDF = 
SSFENU* 
SSFND 1 = 
SSDLE * 
A4FACT= 
BRLX = 
CURRL X* 
INDEX- 
COMMON 
COMMON 
COMMON 
COMMON 
COMMON 
COMMON 
COMMON 
COMMON 
COMMON 
COMMON 


* 

♦ 

♦ 


OR,DZ,YPA ,YPB,F ,G, DX , YQDX , ZM , RM , ANGM , CURVM , S 1M, 
RZONLY, ANGCHO, SINTVL , YP ASQ , YPAB , YPBSQ 
R l ONLY 

SSFML , SSLF , SSLANG , SSDF , SSF E ND , SS FNDl 
, S SDL E, A4F ACT, BRLX, CURRLX 
SSFML 

SSEF, SSDF, SSDLE 

SUPERSONIC CURVATURE FORMULA NUMBER 
SUPERSONIC ENTERING FLOW, T OR F 
ENTERING FLOW ANGLE (DEGREES) FOR SSEF=T 
SUPERSONIC DISCHARGE FLOW, T OR F 

SUPERSONIC BEAM DOWNSTREAM END CONDITION, *0.1 FOR PARABOL 
SUPERSONIC BEAM UPSTREAM END CONDITION, =0,1, FOR PARABOLA 
SS FLOW BELOW AND AF I OF LE PT, T OR F 
CENTRAL POINT INFLUENCE COEFFICIENT FACTOR 
B-REL AXAT I ON FACTOR 
CURVATURE RELAXATION FACTOR 
M=MO , NM 

/ Z ( 300 ) 

/ R ( 300) 

/ S2 ( 300 ) 

/ S l ( 300 ) 

/ PH 1 1 ( 300 ) 

/ J M S ( 300 ) 

/ C UR V ( 300 ) 

/ B ( 300 ) 

/ M , J , MU, MO , I STAG 
/IXORIG/ LHO.LHE, LBDO.LBDE, LTO.LTE, LWO.LWE, LFO.LFE, 
LO.LESTA, LDUM ( 8 ) , 

MO ,NM, NJ.NFCOLS, MAXNJ «MAXOL , MAXNM , MAXLE , 

LEO, LEE, LRO.LRE ,LRD 
LIMITS(2A) 

(LIMITS, LHO) 

( LDUM ( 1 ) , LSO ) , (LDUM ( 2 ) , LSE ) 

W( 128),X2(128), SLCHN ( 128 ) 

SLCHN 


/CZ 

/CR 

/CS2 

/CSl 

/CPH I 1 

/CM 

/CCURV 

/CB 

/CIDEX 


DIMENSION 
EQUIVALENCE 
EQUIVALENCE 
COMMON /SLTAB 
INTEGER 
STATION TABLE 
INDEX- L =L0 , L ESTA 

SCHOKE* STATION CHOKE INDICATOR ( ADJ WF , BRHS , WR IOUT ) 

MCL = SHARP CORNER INDICATOR ( BLDTBS ) 

MCL = FIELD INDEX OF CONTROL STREAMLINE ( PTMOVE ,FLOBAL ) 

COMMON /CHDATA/ X 1 ( 1 ) , LNE XT ( 1 > , ML B ( 1 ) , MUB 1 1 ) , PR I M ( l ) , 


^{£>t 
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1 

1 

3 


TYPELB ( 1 ) *NAMELB ( l)tILB(l)*FLB(l)«SlL8(L)t 
TYPEUBU ) v NAMEUBm tlUB(l) ,FUB(1) tSIUBUU 
VMB( 1 ) *0 WDV ( 1 ) • X2CL(1),VCL(1) »MCL (481 ) 
LOGICAL PRIM 

INTEGER TYPELB, TYPEUB 
DIMENSION SC HOKE ( I ) 

EQUIVALENCE ( SCHOKE,DWDV) 


DIMENSION 

INTEGER 

LOGICAL 

dimension 

EQUIVALENCE 

EQUIVALENCE 

EQUIVALENCE 

EQUIVALENCE 


BDT( n f LBNEXTm,LBZl(U.CHNAMEm t UP III. 

LEDEX( 1) ,ZBT( 1) ,RBT ( I) , ANGBT (42 1 
BDT,CHNAME, BDNAME 
UP 

BDNAME ( 1 ) ,LBA ( 1 ) , LBB ( 1 ) 

( BDNAME , ZBT ) * (LBA.RBT), ( LBB « ANGBT ) 

( X 1 » BD T) , (LNEXTt LBNEXT) , ( MLB* LBZ1 ) « ( HUB, CHNAME ) 
(PRIM, UP )» ( TYPELB, LEDEX) » (NAMELB,ZBT) 

(ILB.RBT), (FLB, ANGBT) 


COMMON /CBEAM / 
COMMON /BENDIN/ 
COMMON /CBEND / 
COMMON /CBITS / 
COMMON /CBDYPT/ 
COMMON /CFB / 
COMMON /CINNER/ 
COMMON /CMAXIT/ 
COMMON /CPI / 
COMMON /CPRINT/ 
COMMON /CPTMOV/ 
COMMON /CQIREM/ 
COMMON /CSLC / 
COMMON /CTABPR/ 
COMMON /ERASE / 
COMMON /ERASE2/ 

1 

LOGICAL 


DBEAM ( 3) , 10RDER 
NBC IN ( 2 ) , ACF (2) 

NBCB ( 2 ) , ANGE ( 2 ) , CURVE (2 ) ,FB (2 ) 

BITS, BLANK 
ANGD.CURVD 
L , MA , M0 , J2» I A ,1 B, I 
INRCTR 

MAXI T.MAJCTR, GREF IN, EDUM 
PI ,TWOPI , PI Q2 »Pl Q4» TODEG, TORAD 
P DuMX ( 6 ) , PDUM { 20 ) 

velpot , icob,nodens,fbastg 
ytol,yo,dydx,ctrmax 

BRANCH (4 ) 

I i TAB 

A( 3) ,B A ( 1 ) , BB ( 1 ) , DA ( I) ,ACHD(1 ) ,CHD( 793 ) 

RB ( 128 ) , ZBt 128) ,ANG ( 128 ) ,CURVB ( 128 ) , SIB ( 128 ) , 
BI (128), J2D0NEU28) , MSV( 128 ) ,CURSS ( 6 ) , QV 1 8 ) 
ALL J2, AN YJ2, J2PREV,PARSLA, UPPER 


DATA LE/2HLE/ 


FIRST PASS ACROSS STREAMLINES, SKIP THOSE SL-S WHICH TERMINATE WITH 
IN THE FIELD IF J2PREV»T. AT END OF PASS ALLJ2-T IF ALL STREAMLI 
HAVE BEEN FITTED AND ANY J2*T IF ONE OR MORE SL-S HAVE BEEN FITTED. 
J2PRE V*F IF ON THE PREVIOUS PASS NO SL-S WERE FITTE 
CONDITION INTERPOLATION REQUIREMENTS COULD NOT BE S 
ANY J2 = .TRUE. 

I F ( PDUM( 1J.GT.0. ) WRITE(6,1159) 

CALL SETM ( 1,0, J2D0NE,NJ) 

RZONLY= .FALSE. 

C BEGIN LOOP THROUGH FIRST TO LAST STREAMLINE, J2*1,NJ 
C CALL MBEGIN TO OBTAIN FIELD INDEX OF FIRST PT ON SL 

100 J2PRE V= ANY J2 
ANY J2 * .FALSE. 

ALL J2 * .TRUE. 

J2 * 1 

101 IF ( J 2 DONE ( J2 ) *EQ. 1 ) GO TO 1ST 


D BECAUSE 
AT I SF I ED. 


END 
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M = M B E G I N ( J 2 ) 

If ( P f)l J M ( D.GT.O. ) WRITE (6,1160) J 2 


C CHECK FOR ORTHOGONAL TERMINATING ON BOW SHOCK (DUMMY STREAMLINE ) 
CALL Gf-TlX 

If ( MU.FG.O .AND. MD.EQ.O I uG TO 180 

BUILD Z B , R B » ANG ARRAYS FUR THE STREAMLINE SEGMENT 
I S T AG = 3 IS A BGUNOAR Y OF A PARTIAL ORTHOGONAL * SUCH POINTS 
ARE TU BE BYPASSED AND THEN FILLED IN BY INTERPOLATION 


1 IS I ^ 1 

S1B( l )= 0. 
120 IA = I 

MA = M 


121 CALL GETIX 

IF< ISTAG.E0.3) GO TO 1 28 
RB( I ) = R ( M ) 

ZB( I ) = Z C M > 

ANG ( I 1= PHI KM J 
Bill) = H ( M ) 

MS V ( I ) = M 

I F ( ISTAG.EO.l .OR. 1STAG.EQ.2) GO TO 130 
124 IF(MD) 126,130,126 
126 I = 1+1 

IB = I 

128 M = MD 

MB * M 

GO TO 121 

C SET END CONDITIONS 
1 30 NBCB( l ) =0 
NBCBt 2 ) =0 
FBI l) = 0. 

FB( 2) = 0. 

L =0 

MDSV = MD 
I S T AGB= ISTAG 

C PARSLA= PARTIAL STREAMLINE AT END A, T OR F 

PARSLA= .FALSE. 

I END = 1 
MX = MA 

IF ( IA ,E0. 1 ) GO TO 2140 
2135 I END = 2 
MX = MB 

IF( MOSV.NE.O) GO TO 135 

C USE AVG CURVATURE B.C. FOR PARTIAL SL-S 

2140 CALL STANO(MX,L, UPPER) 

IF (MX .EO.MLBI L ) .OR. UPPER .UR. 

1 L.LG.LO .OR. (L+LNEXT (L) I.GE.LESTA) GO TO 2180 
M = MLB(L) 

CALL GETIX 

I F ( MU . E Q • 0 .OR. MD.EQ.O) GO TO 2180 
C PARTIAL SL, SEARCH FOR NON- TE RM INAT I NG ADJACENT SL 

SUM = 0. 

CURVX = 0. 

M = MX 

MCHNG = -1 

2150 M = M+MCHNG 




o o o 


CALL GET I X 

IF!MU.EQ.O .OR. MD.EQ.O) GO TO 2150 
I F ( J200NE ( J ) . EQ .0 .AND. J2PREV) GO TO 186 
IF( INRCTR.NE.O) GO TO 2155 
I F ! J 2 DONE ( J ) . EQ.O ) GO TO 2150 
2155 1F(M.LT.MLB(L ) .OR. M.GT.MUB(L)) GO TO 2157 

SUM = SUM+1. 

CUR VX = CURVX+. 5*CURV! M ) 

2157 IF(MCHNG.EQ.l) GO TO 2160 

M = MX 

MCHNG = 1 
GO TO 2150 

2160 CURVX = CURVX/SUM 

NBCB ( I END ) -2 
CURVE! IEND)=CURVX 
I F ( IEND.EO.l > P AR SL A = . TRUE . 

GO TO 2190 

2180 NBCB! IEND)*NBCIN( IEND) 

ANGE! IEN0)=ACF< IENO) 

CURVE! IEND) - ACF ( IEND) 

FB( I END ) =ACF ( IEND ) 

2190 IF! IEND.EO.l) GO TO 2135 

C DEFINE ANG(l) TO OBTAIN CORRECT ANGLE BRANCH 

135 IF! IA.NE.l) GO TO 136 
ANG! 1 )= BRANCH 

IF ! BRANCH.NE .999. ) GO TO 136 
L =0 

M = MSV! 1) 

CALL STANOIM, L, UPPER ) 

IF ( M.NE .MLB ( L ) ) GO TO 1352 
C FIRST STREAMLINE 

LB = LBF (NAMELB !L ) ) 

LB = LB+LBZ11LB) 

ANG ( 1 ) = ANGBTUB) 

GO TO 136 

C NOT FIRST STREAMLINE 

1352 M = M-l 

IF!M.LT.MLB(L ) ) CALL ERR0R1 
CALL GET I X 

IF! J2D0NE! J ) .EQ.O ) GO TO 1352 
ANG! 1 )= PHI KM) 

IF1PDUM! 19) .EO.l. ) WRITE ( 6 , 1 353 ) J , M , ANG 11) 

1353 FORMAT !8H J , M , ANG, 2 16 » F 10. 6 ) 

136 IF! ISTAGB.NE.l ) GO TO 155 


THE STREAMLINE IS TERMINATED BY A STAGNATION POINT. 
PROCEED TO EXTRAPOLATE FOR IIS POSITION IF STAG»i 
ANO BOUNDARY TYPE=LE . 

C FIND THE STAGNATION POINT STATION 
L =0 

CALL STANO!MB,L, UPPER) 

C CHECK FOR LEADING EDGE POINT 
CUR VD = 0. 

I F ( UPPER ) GO TO 138 
IF!TYPELB!L).NE.LE) GO TO 155 
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go to 140 

1 Itl I F ( TYPE lilt ( L ) .NE • L ( ) GO TO 155 

C BEGIN I n RATION FUR SIAGNAIION POSITION 
140 UV( 1 ) = 0. 

SMOVt = 0. 

M = MB 

I F ( ABS(PDUM<5 ) l.LT.5.) FB(2) = l. 

145 IF(UPPER) GO TO 147 
NAMES = NAMELB(L) 

IBS = ILB(L) 

FS = F LB ( L ) 

SIS = S 1 L B C L ) 

GO TO 148 

147 NAMES = NAMFIJBI L ) 

IBS = lUB(L) 

FS = FUB(L) 

SIS = SlUB(L) 

148 CALL BDYPTM(NAMES, IBS, ZB ( I) , R B ( 1 } , F S , St S , SHOVE .GETASK ) 

IF (GF TASK.NE.O. ) CALL ERR0R1 

Z ( M ) = Z B C I ) 

RIM ) = RBI I ) 

CALL BFACS(ZB,R8, ANG,CURVH,S1B, UtlB) 

C (LOGIC FOR LEADING STAGNATION POINT ONLY) 

ERRANG= ANGI I )-( ANGD-PI02 ) 

IFIPDUMID.LE.O.) GO TO 150 

WRITE (6,1149) OVID ,SMOVE,ERRANG,ZB( I ) »RB( I ) ,ANGD,CURVD 

1149 FORMAT I 1 4H STAG PT - QV= F 5 . 0 , 2X ,6HSM0VE = F 1 0 . 5 , 2X , 7HERRANG*F 10 . 6 , 2X 
*,3HZD=Fl0.5,2X.3HRD=Flo.5 f 2X,5HANGD*FL0.3,2X,6HCURVD=F10.6) 

GO TO 1501 

150 IF! CURVD.GE.O. ) GO TO 1501 

WRITE (6,1150) ZB( I ) ,RB( I ),ANGO,CURVD 

1150 FORMA T ( / 3 5H *** NEGATIVE L.E. CURVATURE- Z = Fi0 . 5 , 3X , 2HR= F 10 . 5, 3 

♦X, 4HANG=F 10. 3, 3X, 5HCURV=F 12.6) 

1501 I F ( QV ( 1 ) .NE.O. ) GO TO 151 
YO =0. 

YTOL = l.E-5 

DYDX = ABS(CURVD) + 1 ./ ( SIB ( I)-SlB(I-l)) 

XJP = -ABS( ERRANG) /DYDX 
DYDX = 0. 

151 CALL QIREM( SMOVE, ERRANG, XJP,CV) 

IF ( QV( 1 ) .NE.O. ) GO TO 145 

I F ( UPPER ) GO TO 152 
ILB(L)= IBS 
FLB(L )= FS 
S l L B ( L )=S1S 
GO TO 156 

152 I UB ( L ) = IBS 
FUB (L ) = FS 
SIUB( L )=S1S 
GO TO 156 


USE (SUBSONIC) BEAM FORMULA TO CALC ANG , CURVATURE , SI 
SET IORDER=l TO CHECK FOR POINT ORDERING 
155 NORDER= 1 
1552 IOROER= 1 


7 - 


w 



ANG I 1 1=0. 

CALL BFACSIZB,RB,ANG,CURV8, SIB, IA,IB) 

IF ( IORDER.EQ.O) GO TO 1556 
I = I ORDER- 1 

WRITE (6, 1155) Z B I I ) « RB I I ) * ZB I I ♦ 1) , RB ( I ♦ 1 ) , J2 , I , I ORDER 
I F ( NORDER . GE • 5 ) CALL ERR0R1 
SAV « ZB< I I 
ZB< I) * ZB( hi » 

ZB ( hi 1=SAV 
SAV * RBI I ) 

RBI I ) = Rfllhll 
RBI l + i » = SAV 
NORDER= NORDERM 
GO TO 1552 

1556 IFlSSFML.EQ.I-mCALL BF 3 I ZB , RB , ANG, CURVB • 1 A, IB) 

156 IFISSEF .AND. .NOT .PARSLA ) ANG I 1 ) = SSEANG*TORAD 


C RELOCATE ANSWERS INTO FIELD STORAGE 

160 M = M A 

I = I A- 1 

L =0 

161 CALL GET I X 

IF! I STAG .EQ . 3 ) GO TO 166 
I * I + l 


C SUPERSONIC POINT CURVATURE 

IFIB(M) .GE.O. .OR. I .EQ .1 ) GO TO 163 
IX = 1 

I1SS = I-i-IABSI SSFML I 

NBCBI 1 ) =0 

NBCBI 2 ) *0 

FB(l) = SSFND1 

FBI 2 ) = SSFEND 

I F ( IISS.GT.IX) GO TO 1622 

I1SS = IX 

NBCBI 1 )=2 

CURVE! I )=0. 

1622 NISS = I-USS + 1 

IFINISS.EQ.5) GO TO 1624 

CALL BFACIZBI 1 1 SS ) »RB! 1 1SS) t ANG 1 1 1 SS ) tCURSS.NI SS * 
GO TO 1626 

1624 CALL SS5PTCIZBI IlSSIyRBlI 1SS) tCURSSINISS)) 

1626 PHI 1 1 M ) =ANG I I ) 




CURV(M)=CURSS(NISS ) 

GO TO 164 
163 PH 1 11 M ) = ANG I I ) 

CURVI M )=CURVB I I ) 

IF! I.NE.IA .OR. I.EQ.l) GO TO 164 
PHI II M ) = .5*( ANGI I ) ♦ANGSA V ) 

CURVI M) = . 5* I CURVB I IH-CURSAV) 

IF I ISTAG.NE. 1 .OR. CURVD.LE.U.) GO TO 164 
CURVI M)=CURVD 

FBA STG= FRACTION OF BOUNDARY ANGLE AT STAGNATION POINT.CASC OPTION 
IF I FBASTG.EQ.O. ) GO TO 1632 
CALL STANOIH, L, UPPER ) 

I F ( UPPER J ANGD=ANGD-P I 

16 32 PHI II M ) = .5* lANGSAV + l 1 .-F B ASTG ) * ANG 1 1 KFBASTG*ANGD) 

IF! ISTAG.EQ.l .AND. CURVD.GT.O. ) CURVIMl -CURVO 



non 


C 


164 


1 66 


S 1 ( M ) = S 1 8 ( I ) 

GO TO 168 

INTI RPOL A TE CURVATURE AND LOCATION FOR ISTAG*3 
OR = RR ( 1*1) — R B ( I ) 

0 Z = L B ( I ♦ 1 )- ZB C I ) 

CHI) = SORT I DR*DR+DZ*DZ ) 

CS = OZ/CHO 

SN = DR/CHD 

ACHO = ATAN3IDR,DZ,ANG{ I ) ) 

F = ( CS*( Z < M > - ZB ( I ) ) +SN*{R(M)-RB (1) ) ) /CHD 

I F I F . G T • 1 . .OR. f.LT.O.) CALL EKROR1 


POINTS 


G = l.-F 

YP A = T AN I ANG I I l-ACHO) 

YPR = TAN( ANG( I + U-ACHO) 

CALL BFI 

RM = RBI I > +RM 
ZM = Z B ( I )*ZM 

GUARD AGAINST UNREASONABLE INTERPOLATION 
FIRST CHECK FOR EXISTENCE OF I M-l > AND (M+i) 

THEN LIMIT THE POINT RELOCATION TO 25PC OF DIST. TO THESE NEIGHBOR 
F =1. 

CALL STANOlM,L, UPPER) 

IF(M.LE.MLB(L ) .OR. UPPER) GO TO 167 
DM = ( R ( M ) — RM ) **2 ♦ IZIM)-ZM)**2 
D1 = IR(M)-RlM-l) )**2 ♦ (Z(M)-Z(M-1))**2 

D2 4 = IRIM)-R(M+1) )**2 ♦ ( Z I M )-Z I M+l )) **2 

IFIDM.LT. ,01*D1) GO TO 167 

F = AMINKl.t. 25* SORT I AM INI ( D 1 ,D2 ) / DM ) ) 

167 RIM) = F*RM+( l.-F )*RIM) 

ZIM) = F *ZM+ I l.-F )*Z (M) 

PHI K M ) = ACHD+ ANGM 
CUR V I M ) -CUR VM 
S1IM) * S1BI I J+S1M 

C 168 IF! I.GE.IB) GO TO 170 

168 IFIPDUMI D.LE.O.) GO TO 1690 
IFI PDUMI 1 ) .EO.l. ) GO TO 1680 

IF! PUUMI l I.E0.2..AND. BIID.LT.O.) GO TO 1680 
IF I PDUMI 1 ) .EQ.4. .AND. ISTAG.NE.O) GO TO 1680 
X J 2 = J 2 

IF( PDUMI l J.GE.5. .AND. X J2.GE .PDUMI 8 ) .AND. PDUMI 1 ) . GE.XJ2 ) 

1 GO TO 1680 
GO TO 1690 

16 80 WRI TE I 6, 1161 ) I , M , I S TAG , Z I M ) , R ( M> , PH 1 1 1 M) ,CURV I M ) , CURVB I I ) ,BII) 

1159 FORMAT! 1H1 ) 

1160 FORMAT I12H I M I S TAG, 5 X , 1 HZ , 9X , 1HR ,4X ,4HPH 1 1 f 4X ,4HCURV , 3X , 

1 5HCUK VB , 9X * 1 HB • 5H J=,i3) 

1161 FORMA I I IX, I 3, 14, I 2, 2F10. 5,F 8.4,2F8. 5,F10.3 ) 

1690 IMI.GF.1H) GO TO 170 

M = MO 


GO TO 161 


C 


C 


INDEX TO NEXT STREAMLINE SEGMENT 
170 IFIMD) 172,180,172 
172 IA = IB 

MA = M 


I = IB 

ANGSAV= ANG I I ) 
CUR S AV = CURVB II) 



C (TRANSFER TO 126 RATHER THAN 120 SINCE 1ST POINT* I-IAMB, IS SAVE 

GO TO 126 

C STREAMLINE J 2 HAS BEEN CURVE-FITTED, INDEX J2 TO NEXT SL. 

180 J2D0NE ( J2 )= 1 
ANY J2 * .TRUE. 

GO TO 187 

C END CONDITION INTERPOLATION NOT POSSIBLE, BYPASS THIS SL 

186 ALL J2 ■ .FALSE. 

187 J 2 = J2+ 1 

IFU2.LE.NJ) GO TO 101 

C GO BACK FOR 2N0, 3RD PASS TO INTERPOLATE FOR CURVATURE AT PARTIAL S 
IF ( .NOT • ALL J2 ) GO TO 100 

RZONL Y= .TRUE. 

RETURN 

1155 FORMAT (27H * SLC IS INTERCHANGING P TS.F l l . 5 , 1H, F 10. 5 ,6H AND, 

l F11.5,1H,F10.5,4H J=I3,5H I*2I2> 

END 




onooo ooooonoonooo 


-SPC- 


SPC 

SUBROUTINE SPC 

SONIC POINT CURVATURE 

COMMON /CSS / SSFML , SSE F , SSF ANG , SSDF , SSFEND, SSFNDi 
1 tSSDIE ,A4FACT, HR L X , CURRLX , T S I C 

INTEGER SSFML 

LOGICAL SSE F » SSDF, SSDLE 

SSFML = SUPERSONIC CURVATURE FORMULA NUMBER 
SSEF = SUPERSONIC ENTERING FLOW, T OR F 
SSE ANG= ENTERING FLOW ANGLE (DEGREES) FOR SSEF=T 
SSDF = SUPERSONIC DISCHARGE FLOW, T OR F 

SS F END= SUPFR SON 1 C BEAM DOWNSTREAM END CONDITION, =0,1 FOR PARABOL 
SS FND 1 = SUPERSONIC BEAM UPSTREAM END CONDITION, =0*1, FOR PARABOLA 
SSDLE = SS FLOW BELOW AND AFT OF LE PT, T OR F 
A4F ACT= CENTRAL POINT INFLUENCE COEFFICIENT FACTOR 
BRL X = B-REL AXA T I ON FACTOR 
CURRL X= CURVATURE RELAXATION FACTOR 

TSIC = NUMBER OF POINTS TO BE USED FOR TRANSONIC INTERPOLATION 
OF CURVATURE 

COMMON /IXORIG/ L HO , LHE , LBDO ,LBDE , LTO,LTE , LWO,LWE, LFO,LFE , 

* LO.LESTA, LDUM ( 8 I * 

* MO , NM , N J ,NFCOLS, MA XN J , MAXOL , MAXNM, MAXLE * 

* LEO, LEE, LRO , LRE , LRD 

DIMENSION LIMITS(24) 

EQUIVALENCE (LIMITS, LHO) 

COMMON /SLTAB / W ( 12 8 J , X 2 ( 12 8 ) ♦ SLCHN ( 1 2 8 ) 

INTEGER SLCHN 

STATION TABLE 
INDEX- l=lo,lesta 

SCHOK E= STATION CHOKE INDICATOR ( ADJWF ,BRHS ,WR IOUT ) 

MCL = SHARP CORNER INDICATUK (BLDTBS ) 

MCL = FIELD INDEX OF CONTROL STREAMLINE ( PT MOVE , FLOBAL ) 

COMMON /CHDATA/ X 1 ( 1 ) , LNE XT ( 1 ) , MLB ( l ) , MUB ( l ) , PRI M ( 1 ) , 

I TYPE LB ( 1 ) ,NAMELB( 1 ) , I LB ( 1 ) , FL B (1) , S 1 L B( 1 ) , 

1 TYPEUB( 1) , NAMEUB ( 1), IUB(1) ,FUB(1 ) ,S1UB( 1) , 

3 VMh ( 1 ) ,DW()V( l ) , X2CL(l),VCL(l),MCL(481) 

LOGICAL PRIM 

INTEGER typelb,typeub 

DIMENSION SCHOKE(l) 

EQUIVALENCE ( SCHOKE , D WDV ) 

DIMENSION SLSWI(l) 

EQUIVALENCE (SLSWl,VCL) 

C SLSWI = SONIC LINE/SHOCK WAVE INDICATOR 

COMMON /CB / B ( 300 ) 

COMMON /CCURV / CURV(300) 

COMMON /CIDEX / M , J , MU , MD , I S T AG 
COMMON /CS2 / S 2 ( 300 ) 

C RECOMPUTE NEAR SONIC PT CURVATURES BY LINEAR INTERPOLATION 

C BEGIN LOOP THROUGH STATIONS 
I F ( T S IC.EO.O. ) RETURN 
L * LO 

CHECK FOR STAGNATION BOUNDARY POINT 
30 MA = MLB(L) 



•DECK 

♦GPC-- 


C 



M = MA 

CALL GET I X 

I F ( ISTAG.NE.l) GO TO 40 
MA = MA+1 
40 MB = MUB(L ) 

M = MB 

CALL GET IX 

I F ( ISTAG.NE.l ) GO TO 50 
MB « MB- 1 

C LOCATE SONIC POINT 

50 I F ( SLSWIIL I.EQ.O. I GO TO 140 
M = MA+1 

60 I F ( ( B ( M ) *B ( M- 1 ) ) • GE • 0 • ) GO TO 65 
CALL GET I X 

1 F ( W ( JI.NE.O.) GO TO 70 
65 M = M + l 

IFIM.GT.MB) GO TO 140 
GO TO 60 

C F FRACTIONAL DISTANCE TO SONIC LINE ABOVE PT (M-i) 

70 F = B(M-n/(B(M-l)-BIM) ) 

C CALCULATION - INTERPOLATION JUNCTURE POINTS 

OF X = AMIN1 (TSIC.AMINl ( FLOAT! M-l-MA ) *F , FLOAT (MB-M+1 ) -F ) ) 

FX1 = F-DFX 

FX2 = F+OFX 

MX 1 * M 

MX 2 = M 

80 IFIFXl.GE.O. .OR. I MXl-i ) .LE .MA ) GO TO 90 
MX 1 = MX1-1 

FXl = FX1+1. 

GO TO 80 

90 IFIFX2.LE.I. .OR. MX2.GE.MB) GO TO 100 
MX 2 = MX2+1 

FX2 = FX2-1. 

GO TO 90 

100 SXl = S2(MXl-l)+FXl*(S2(MXl)-S2!MXl-m 

SX2 = S2(MX2-i)+FX2*(S2(MX2)-S2CMX2-l) ) 

C CALCULATE LINEAR VARIATION OF CURVATURE BET JUNCTURE PTS 
CXI = CURVIMXi-l H-FX1* (CURV(MXl)-CURV(MXl-l >> 

CX2 » CURVIMX2-1HFX2* (CURVCMX2 I-CURVI MX2-1 )) 

MX x MX1 "" 

120 I F ( MX .GE .MX 2 ) GO TO 65 

CUR VI MX)*(CXl*(SX2-S2(MX) >+CX2* I S2 (MX)-SXl )) / I SX2-SX1 ) 

MX » MX«-l 
GO TO 120 

C INDEX TO THE NEXT STATION 

140 L * L+LNEXTIL) 

IF ( L.LT .LESTA ) GO TO 50 


RETURN 

END 



♦ DICK SSSPTC 

SUBROUTINE SS5P TC < XX ,YY,CURV ) 

♦SS5PTC SUPERSONIC 5-PF CUR VATURfc FORMULA -SS5PTC- 

OlMI.NSION XX < 1 I , Y Y ( 1 I 

c input- 

C XX, YY = COORDINATES of FIVE PGI NTS C I =1-5 » 


C OUTPUT- 

C CUR V = CURVATURE OF THE LAST POINT (1=5) 

COMMON /CSS5P T / X(4),Y<4), X2 1 , X3 1 , X 32 , X41 , X*2 , X43 ♦ AO , Al , A2, A3, A4 


C 


ALP = ATAN2( YY( 5 )-YY(l) ,XXI 5)-XX(l ) ) 

SN = SIN(ALP) 

CS = COS (ALP) 

X ( 0 ) = 0 . 

DO 60 1 = 1, A 

X ( I ) = ( XX ( hl)-XXim*CS+(YY( I«-l )-YY( 1 ») *SN 
60 Y ( I ) = (YY( I + l )-YY( 1) )*CS-(XX( I + D-XXd) )*SN 
CALL SS5PT 

D2YDX2= Y ( 1 )*AUY( 2)*A2+Y(3)*A3+Y(4)*A4 

CUR V = -D2YDX2 

RETURN 

END 




ooooo oooo 


• DECK ST TOE I 

SUBROUTINE STTOF I ( L l ,MDl ) 

♦ STT0F1 ADJUST THE STAT I ON- T ABLE POINTERS -STTOFl- 

C TO THE FIELD-TABLE UPWARD BY HDI 

INPUT- 

L 1 2 FIRST STATION FOR WHICH POINTERS MUB (L) « MLB! LI MUST BE A 

MDI = INCREMENT TO BE AODED TO MLB (L) AND MUB(L). 

MUB ( L ) « MLB ( L ) POINT TO THE FIELD-TABLE 

COMMON /IXORIG/ L HO » LHE » LBDO.LBDE, LTOtLTE , LWO* LWE « LFO»LFE * 

* LO »L ESTA » LDUM ( 8 ) , 

* MO »NM , NJ.NFCOLS, MAXN J» MAXOL f MAXNM* MAXLE « 

* LEOtLEE, LROtLREtLRO 

DIMENSION LIMITSI24) 

EQUIVALENCE (LIMITS, LHO) 

STATION TABLE 
INDEX- L=LO,LESTA 

SCHOKE= STATION CHOKE INDICATOR ( AD JWF , BRHS , WRIOUT ) 

MCL = SHARP CORNER INDICATOR (BLDTBSI 

MCL = FIELD INDEX OF CONTROL STREAMLINE ( PTMOVE ,FLOBAL) 

COMMON /CHDATA/ X I ( I ) , LNE XT (II , MLB (I> , MUB ( I ) , PRI MU ) , 

1 TYPE LB ( 1 ) V NAMELB(1) , I LB ( I) ,FLB(1 ) *SILB( l ) • 

I TYPEUBd J ,NAMEUB(1J,IUB(1) ,FUB <1 ) ,S1UB( l ) , 

3 VMB( 1) ,DWDVm, X2CL ( I ) , VCL ( 1 ) ,MCL ( 48 1 ) 

LOGICAL PRIM 

INTEGER TYPELB.TYPEUB 
DIMENSION SCHOKE(l) 

EQUIVALENCE ( SCHOKE , DWDV ) 

COMMON /CBITS / BITS, BLANK 

L = LI 

MD = MDI 

MUBIL )= MUB ( L ) +MD 

I F ( (MUB(L )-MLB(L > ).LT. MAXOL) GO TO 60 
CALL ERROR 1 
60 L = L+LNtXT ( L ) 

IF(L.GE.LESTA) GO TO 900 
MLB ( L )= MLB ( L ) +MD 
MUB ( L ) - MUB ( L ) +MD 
GO TO 60 

900 RETURN 
END 

0VERLAY(STC,4,0) 




• OECK USECDM 

BLOCK DATA USECOH 

•USECDM REPLACE STCM USE CARDS 


COMMON 

/CA2 

/ 

A2 ( 730 ) 

COMMON 

/CA2 

/ 

A2 ( 768 ) 

COMMON 

/C A3 

/ 

A 3 ( 768 ) 

COMMON 

/CA4 

/ 

A4( 768) 

COMMON 

/CAS 

/ 

A5( 768) 

COMMON 

/CA6 

/ 

Afa J 768 ) 

COMMON 

/CA7 

/ 

A7( 768) 

COMMON 

END 

/CA8 

/ 

A 8 ( 768 ) 




n o o o r* 


* 1)1 f.K I M U r J !-» M 

SUBKUU r INI f K K ( J M 1 

C f UUM PM f DUMP I HI' S TCM I. INK 


C 


C 


LBDU,LBDE, LTG,LTE, 

LO ,LE STA , L0UMI8), 

MQ , NM , NJ.NFCGLS, MA XN J , MA XOL • MAXNM , 
LEO, LEE, LRO » LRE , LRD 
L 1 M I TS<24 ) 

( L I M I T S , L HO I 

W( 128),X2(12d),SLCHN(128> 


LWO.LWE, LFO.LFE, 


MAXLE 


I ABLE UF INDEX LIMITS 
COMMON /IXORIG/ L HO , L HE , 

* 

* 

* 

OIMLNS ION 
LOU I VALENCE 
STREAMLINE TABLE 
COMMON / SL TAB / 

INTEGER SLCHN 
STATION TABLE 
INDEX- L=LO,LESTA 

SC HOK E = STATION CHOKE INDICATOR ( AD J WF , BRHS , WR IOUT > 

MCL = SHARP CORNER INDICATOR (BLDTBS) 

MCL = FIELD INDEX OF CONTROL STREAMLINE ( PT MOVE , FLOBAL ) 

COMMON /CHOATA/ X L (1) . LNE XT (II , MLB (1) ,MUB ( II t PRI M ( 1 » , 

I TYPE LB ( 1) »NAMELB ( 1 ) , I L B ( I ) , F L B ( 1 ) , S 1 L B I II , 

1 TYPEUB ( 1 ) » NAMEUB I I ) , I UB ( 1 ) , FUB (i) * SI UB ( I ) , 

3 VMB(l) ,DWDV( 1 ), X2CL II) ,VCL( 1) ,MCL (A81 ) 

LOGICAL PRIM 

INTEGER TYPELB, TYPEUB 


DIMENSION 


SCHOKE ( 1 I 

equivalence 


( SCHOKE , OHDV I 

COMMON 

/CA2 

/ 

A2( 300) 

COMMON 

/C A 3 

/ 

A3( 300) 

COMMON 

/CAA 

/ 

AA( 300 ) 

COMMON 

/CA5 

/ 

A 5 ( 3 00 ) 

COMMON 

/CA6 

/ 

A 6 ( 3 00 ) 

COMMON 

/CA7 

/ 

A7( 300 ) 

COMMON 

/CA8 

/ 

AB1300) 

COMMON 

/CB 

/ 

B( 300) 

COMMON 

/CCURV 

/ 

CUR V ( 300 ) 

COMMON 

/COS2 

/ 

DS2 ( 300) 

COMMON 

/CDDS2 

/ 

DDS2 

COMMON 

/CFB 

/ 

L , MA , MB » PLB » PUB , WF , CHOKE » SUBSON 




XCHOKE, TAREA.VMBC, WRQST,WCALC 




J SUM , VML B SQ 

LOGICAL 


CHOKE, SUBSON 

COMMON 

/C IDEX/ Cl ( 5) 

COMMON 

/C I DEXR/ 

C2I25) 

COMMON 

/CPH 1 1 

/ 

PHI1I300) 

COMMON 

/CR 

/ 

R ( 300) 

COMMON 

/CRH S 

/ 

KHS( 300) 

COMMON 

/CSl 

/ 

SI ( 300) 

COMMON 

/CS2 

/ 

S 2 I 300 ) 

COMMON 

/CTABPR/ 

I 1TAB 

COMMON 

/CTOLRL/ 

C 3 ( l 2 ) 

COMMON 

/CVM 

/ 

VM ( 300 ) 

COMMON 

/Cl 

/ 

Z ( 300) 


NK » PLBC t PUBC » 
QV ( 8 ) , QVP I B I , 


CALL TABPRT ( 3HCFB»L» 33»A ) 

CALL TABPRT ( 5HC I DEX ,C 1 , 5 , 5 ) 
CALL TABPRT ( 6HC I DEXR , C2 , 25 , 5 ) 




CALL TABPRT ( 6HCT0LRL »C3 , 6, 6 ) 

11TAB = LO 

CALL TABPRT ( 6HSTATAB, XI ,LE STA, 5) 

CALL JMSPRT 

CALL TABPRT ( 2HS 1 , SI ,NM, 10 ) 

CALL TABPRT ( 2HS2 , S2 #NM, 10 ) 

CALL TABPRT ( 1HZ . Z ,NM, 10 ) 

CALL TABPRT ( 1HR , R ,NM, 10 ) 

CALL TAHPRTUHCURV,CURV»NM,lo) 

CALL TABPRT ( 2HVM , VM,NM, 10) 

WRITE (6,1000) 

DO 100 1=1, NM 

WRITE (6,1001) I , B ( I ),A2(I),A3(I),AAU).A5(I) , A6 ( I ) , A7 ( I ) , A8 ( I ) , 
1 DS 2 ( I ) »RHS ( I ) 

100 CONTINUE 

WRITE (6,1002) DDS2 

1000 FORMAT ( <»H1 M,11X,1HB, 1 OX, 2HA2 , 10X , 2HA3 , 10X , 2HA4 , 10X,2HA5,10X, 

1 2HA6, 10X, 2HA7, 10X , 2HA 8, 9X , 3HDS2 , 9X , 3HRHS ) 

1001 FORMAT (1H , I 3 , 8F 1 2. 3 , 2F 1 2 . 6 ) 

1002 FORMA T ( / / /8H DS2MX=,F 12.6) 

LSTOP = 5 

GO TO ( 999, 999 ) , LSTOP 
999 RETURN 
END 



ooooooo no noon on noon 


-MCOEF- 


*01 (.K MCUI t 

MJBMIJUT INI Ml Of I 

"Vf.fJl I MA TIM X CUT I f If, II NT 


C INPUT- 

W(J) = r ,L HOW 

SUM) = DISTANCE ALONG STREAMLINES 
RIM) = COEFFICIENT OF THE CURVATURE TERM 
STATION TABLE 


OUTPUT- 

AI (M) ,A2(M),..A8(M) = MATRIX COEFICIENT ARRAYS M=i,NM 


STAR ARRANGEMENT IS - 


AI A2 A3 


AS 

A 4 A5 A6 

A7 


NOTE - A4 IS ALWAYS NEGATIVE EXCEPT FOR THE FIRST OF DOUBLE POINT 
THEN A4(M>=1., A 8 ( M ) =- 1 . 


COMMON 

/BENDIN/ 

NBCIM 2) , ACF ( 2) 

COMMON 

/CA2 

/ 

A2 (300) 

COMMON 

/CA3 

/ 

A 3 ( 300 ) 

COMMON 

/CA4 

/ 

A4I300) 

COMMON 

/CA5 

/ 

A5I300) 

COMMON 

/CA6 

/ 

A6( 300) 

COMMON 

/CA7 

/ 

A 7 ( 300 ) 

COMMON 

/CA8 

/ 

A 8 ( 300 ) 

0 I MENS ION 


AO ( 300 ) , A 1 ( 300) 

EQUIVALENCE 


( A0,A6) , ( AI , A3) 

COMMON 

/CATM 

/ 

N X , XD I M , G ( 25 ) 

COMMON 

/CB 

/ 

B( 300) 

COMMON 

/CBITS 

/ 

B ITS .BLANK 

COMMON 

/CCUBE 

/ 

NBC(2),C1(2) , C 2 ( 2 ) , FEND (2) 

COMMON 

/CCURV 

/ 

CURVI 300 ) 

COMMON 

/CFB 

/ 

L , MA , MB , DFB ( 30) 

COMMON 

/CFFINC/ 

OF F ( 6 ) 

COMMON 

/CFRFIN/ 

AT INF 

COMMON 

/CIDEX 

/ 

M, J,MU,MD,I STAG 

COMMON 

/CMAXI T/ 

MAXI T ,MA JCTR , GREF IN 

COMMON 

/CPI 

/ 

P I ,TWOPI ,PIQ2,PIQ4, TODEG , T ORAD 

COMMON 

/CPRINT 

/ 

PRTE S2,PRTB,PRTA,PREFIN,PREFN2,SSONIC,PDUM( 10) 

COMMON 

/CR 

/ 

R( 300) 

COMMON 

/CRHS 

/ 

RHS ( 300) 

COMMON 

/CS1 

/ 

SI (300) 

COMMON 

/css 

/ 

S SFML, SSE F, SSE ANG, SSDF, SSFEND, SSFND1 


1 , SSDl E, A4FACT,BRLX,CURRLX,TSIC,RH0C,RH0CSS 

INTEGER SSFML 

LOGICAL SSEF, SSDF, SSDLE 

SSFML = SUPERSONIC CURVATURE FORMULA NUMBER 
SSEF = SUPERSONIC ENTERING FLOW, T OR F 
SSE ANG= ENTERING FLOW ANGLE (DEGREES) FOR SSEF=T 
SSOF = SUPERSONIC DISCHARGE FLOW, T OR F 

SSF END = SUPERSONIC REAM DOWNSTREAM END CONDITION, =0,1 FOR PARABOL 
SSFNU1 = SUPERSONIC BEAM UPSTRT AM END CONDITION, =0,1, FOR PARABOLA 
SSDLE = SS FLOW BELOW AND AFT OF LE PT, T OR F 



ooooo ooo 


A4F ACT= CENTRAL POINT INFLUENCE COEFFICIENT FACTOR 


BRLX = B-REL AXAT ION FACTOR 

CURRL X * CURVATURE RELAXATION FACTOR 

COMMON /CVM / 

VM ( 300 ) 

COMMON /CXG / 

XO « X ( 6 ) 

COMMON /ALLCOM/ 

MACHA , PSA , TSA ,PTA,TTA« AXI A , RGA, GAMA, 
M ACHC ♦ PSC » TSC tPTC • TTC» AXIC »RGC,GAMC? 
DAXIT,SCALEA,TTE,CHOTST 

REAL 

MACHA ( 1 ) t MAC HC 

LOGICAL 

AXlAfAXIC 

LOGICAL 

CHOTST 

COMMON /IXORIG/ 

! 

{ 

LHOf LHE » LBDUtLBDE * LTO*LTE « LWO,LWE t LFOtLFE * 
LO,LESTA, LDUM ( 8 ) * 

MO tNM » NJ.NFCOLS, MAXN J , MAXOL , MAXNM, MAXLE ♦ 

LEO, LEE* LROt LRE , LRD 

DIMENSION 

LIMITSI2AI 

EQUIVALENCE 

(LIMITS, LHO) 

COMMON /SLTAB / 

W( 128) ,X2( 128), SLCHN (128) 

INTEGER SLCHN 



STATION TABLE 
INDEX- L = L0 , L ES TA 

SCHOKE= STATION CHOKE INDICATOR ( AD J WF « BRHS ♦ WR IOUT ) 

MCL = SHARP CORNER INDICATOR (BLDTBS) 

MCL = FIELD INDEX OF CONTROL STREAMLINE ( PTMOVE .FLOBAL ) 

COMMON /CHDATA/ X 1 (1) , LNE XT (1) ,MLB II) , MUB 1 1 > , PRl Mil) , 

1 TYPELB(ll,NAMELBU),ILB(ll,FLBm,SlLB(l), 

I TYPEUBm.NAMEUBtl), IUB(l) ,FUB(I ) .S1UBI1) , 

3 VMB( 1 ) »DWDV I 1 ) » X2CL ( 1) , VCL ( 1 ) ,MCL ( 48 1 ) 

LOGICAL PRIM 

INTEGER TYPELB. TYPEUB 
DIMENSION SCHOKE(l) 

EQUIVALENCE ( SCHOKE.DWOV) 


INTEGER F I ELD , FRE E ,F ARF LD ,PRE S tOLBC 

LOGICAL SLBDY.SUBDY 

DATA FIELD/5HFIELD/ 

DATA FREE/4HFREE/, F ARFLD/6HF ARFLD/ » PRE S/4HPRES/ * OLBC/4HOLBC/ 


C 


c 


BEGIN 

LOOP THROUGH 

THE 

STATIONS 

L 

= 

LO 




BEGIN 

LOOP ACROSS 

THE 

STREAMLINES 

800 MA 

= 

MLB ( 

L ) 



MB 

= 

MUB ( 

L ) 



M 

= 

MA 




810 A2(M> 

= 

0. 




A3 ( M ) 

= 

0. 




A4( M) 

= 

0. 




A5(M) 

= 

0. 




A6(M) 

s: 

0. 




A7(M) 


0. 




A8( M) 

= 

0. 




MCENTR= 

M 






c 


INITIALIZE /CCUBE/ FOR CUFITR 



o o o u o 


C 1 l 1 ) = 0 . 

r. l ( 2 ) = o . 

C 2 ( 1 ) = 0 . 

C 2 ( 2 ) = 0 . 


C CHECK FOR SPECIAL (FREE, PRES, UR FARFLD) BOUNDARY 
SL BUY = .FALSE. 

SUBOY = .FALSE. 

IF(M.NE.MA) GO TO 824 
IF ( IYPFI 11(1 ) . FO . ( RFF .OK. 

1 1 Y P F: l B ( L » . F U . F AR F L D . OK . 

1 mo I H ( L ) . I (J.f 1 1 L 0 .UR . 

* fYl'd lilL F.LO.ULRC .OR. 

2 IYPFI B ( I ) . ( CJ . P R f S ) SL HOY - . TRUE . 

IE ( .GOT . SL BUY ) GO TO 825 

M 2 A I F ( M .OF -MU ) GO TO 826 

IF( TYPE UB(L).EU. FREE .OR. 

1 TYPEUBJ L ) .EO.FARFLU .OR. 

3 TYPEUB(L ) .EO.F IELD .OR. 

A TYPEUB( L ) . EO.OLBC .OR. 

2 TYPEUBU I.EQ.PRES) SUBDY= . TR UE . 

IF(SUbDY) GO TO 826 

C SOL I D WALL BOUNDARY 

825 A4( M) = -1. 

GO TO 980 

INTERIOR POINT 

BUILD X-TABLE OF DISTANCES TO NEIGHBORING POINTS ALONG THE STREAMLI 
POINTS WITH 1ST AG = 3 ARE TO BE OMITTED. 

SPECIAL END CONDITIONS ARE 10 BE UTILIZED IF THE X-TABLE IS FERMI 
BY A STAGNATION POINT 

826 CALL GETIX 

J C E N T R = J 
I S T AGC = I STAG 
X ( A ) = S 1 ( M ) 

I C I =4 
I C 2 = A 

NBC ( n= 2 
NBC ( 2 ) = 2 
C 2 ( 1 ) = 0. 

C2( 2) =0. 

MDQWN = MD 

831 M = MU 

IF(M.EQ.O) GO TO 850 
CALL GETIX 

I F ( ISTAG.E0.3) GO TO 831 
X ( 3 ) = S1(M) 

IC1 =3 

I F ( 1ST AG.NE .0 ) GO TO 850 

I F ( SSFML.LT. 0 .AND. B ( MC ENTK ) • GE • 0. .AND. PDUMC 1 2 ) . EQ. ( -I . ) ) 
l GO TO 850 

8 A l M = MU 

IF(M.EC.O) GO TO 850 
CALL GETIX 




I F C ISTAG.EQ.3) GO TO 841 
X( 2 ) * S1(M) 

I C 1 =2 

846 I F ( BlMCENTR) .GT.O. ) GO TO 850 

IF! IABSISSFML ).EQ.l ) GO TO 850 
M = MU 

IF(M.EQ.O) GO TO 850 
CALL GET IX 

1 F ( ISTAG.EQ.3) GO TO 846 
xt i ) = si(M) 

ici = i 

848 I F ( SSFML.NE.3 ) GO TO 850 
ICI =2 
M = MU 

I F ( M.EQ.O ) GO TO 850 
CALL GET IX 

I F ( ISTAG.EQ.3 ) GO TO 848 
XO * Sl(M) 

ICI = 0 

C UPSTREAM STREAMLINE ENO CONDITION 

850 IF(MU) 854,852*854 
852 NBC ( 1 ) = NBC IN ( 1) 

FEND( 1 )=ACF( 1 ) 

C DOWNSTREAM POINTS, BYPASS FOR SUPERSONIC FLOW 

854 IFIB(MCENTR).LE.O. ) GO TO 874 
MD = MDOWN 
856 M = MD 

IF(M.fcQ.O) GO TO 870 
CALL GETIX 

I F ( ISTAG.EQ.3) GO TO 856 
XI 5) = SUM) 

I C 2 = 5 

I F ( ISTAG.NE.O) GO TO 865 

1 F I SSFML.LT.O .AND. PDUM(12>.EQ.(-1.) ) GO TO 865 

861 M = MD 

IF(M.EG.O) GO TO 870 
CALL GETIX 

C I F ( B ( M ) .LE.O. .AND. B(MU).LE.O.) GO TO 874 

IF! ISTAG.EQ.3) GO TO 861 
X ( 6 ) = Sl(M) 

IC2 = 6 

C SPECIAL DOWNSTREAM END CONDITIONS FOR LEADING EDGE STAGNATION POINT 
865 IFI ISTAG.NE.l ) GO TO 870 
NBC ( 2 ) = 4 
C 1 ( 2 ) = CURV(M) 

FEND! 2 ) = 1 • 

IFI ABSIPDUMI5) J.GE.5.) FEND! 2) =0. 

C DOWNSTREAM STREAMLINE END CONDITIONS 
870 IF ( MD ) 878,872,878 
872 NBC I 2 ) = NBC IN ( 2 ) 

FEND! 2 ) S ACF ( 2 ) 




Gl ) 1 1 1 8 78 

f. HOUNUAkY CCjNfJ I T I f JN ON 4-POINT SUPERSONIC BE AM-CUR VATUR E FORMULA 
8 74 I ( NIJ( 2 ) SSFf 00 
H N U I l ) =SSFN01 
NBC 12) = 0 
NBC ( 1 ) = 0 

C SUPERSONIC 5-PT FORMULA 

1 F ( SSFML.NL. 3 .OR. IC1.NE.0 ) GO TO 878 
CALL SS5PTK X0,G ) 

GO ro 900 

C CALL CUBIR TO OBTAIN SECOND ORDER DIFFERENCE FORMULA, 02 ( ON ) / D I S 1 ) 2 

C ANSwIRS ARE STORED IN G(IG.JG), JG = I , IC2- I Cl ♦ 1 , IG=MID POINT 

H 7b NIC = I C 2- I C 1 ♦ 1 

I F ( ISIAGC.E0.3I GO TO ttttO 
IFINIC.LE.2) GO TO 908 
CALL CUDERSIXI IC1 I, NIC) 

GO TO 900 

C CALL CUFITR FOR INFLUENCE COEFFICIENTS, DS2 13) =F I DS2 I 1 ) , DS2 < 2 ) , DS ( 4 

C FOR INFIELD BOUNDARY PO INTI 1ST AG = 3) 

880 CALL CUFITRIXI IC1),NIC,5-IC1) 

C****DEFINL ALL COEFFICIENTS OF THE EQUATION FOR FIELD POINT M 


c 

IG 

= 4-ICl+l 

c 

JG 

= I C- I C 1 ♦ 1 

c 

I JG 

= I JG- 1 ) +5 ♦ IG 

c 

I JG 

= CENTER POINT INDEX IN G-ARRAY 

900 

I JG 

= 2 5- I C 1* 6 


IF(Pf)UM(5).LE.O. I GO TO 907 

IF ( ISTAGC.NE. 3 .AND. POUM (5 ) .10 . 3. ) GO TO 907 
1FIPDUMI5I.GE.4. .AND. NUC(2).NE.4) GO TO 907 
WRITE (6, 1907) JCE NTR , MC E NTR , 1C 1 , I C2 , I JG 
1907 F0RMATI//3H J=I3,9H MCENTR=I3,7H IC1=I3,7H IC2*I3,6H IJG=I3) 

CALL I ABPR T I 1HX, X I I Cl), NIC, 8) 

CALL I AMPRT I 5HCCIJBE , NBC ,8,8) 

CALL I AHPRTI 1 HG, G , 28 , 8 ) 

907 CONTINUE 

C CHECK FOR INFIELD BOUNDARY POINT OR SPECIAL BOUNDARY 

90b IF ( .NOT .SLBDY .AND. .NOT . SUBDY .AND. ISTAGC.NE. 3) GO TO 910 
M = MCENTR 

GO TO 926 

C FIRST POINT OF A DOUBLE SL , CHICK WIJCENTR+l) 

910 M = MCENTR* l 

CALL GE T I X 

IF ( Ml J ) .NE .0. ) GO TO 915 
M = MCENTR 

J = JCENTR 

GO TO 926 

C POINTS 7, 8, AND 4 
915 JP = J 
MP = M 
JM = JCENTR 

'P-S' 5 ’ 



o o o o o 


M = MCENTR-1 

IF(W( JCENTRI.NE.O. ) GO TO 920 
CALL GET I X 
JM = J 
M = MCENTR-2 

920 CALL GET I X 
MM 1 = M 

JM1 = J 
M = MCENTR 

J = JCENTR 

A7(M) = l./(W< JM)-W( JM1) J 
A8(M) = 1 . / ( W ( JP )- W( J ) ) 

A4(M) = -A71M)-A8(M) 

I F ( .NOT. AX IA) GO TO 926 
A4(M) = TW0Pl*R<M)*A4(M) 

A7(M) = TWOP I *R ( MM 1 ) *A7( M ) 

A8(MJ = TW0PI*R(M*1)*A8(M ) 

C POINTS It 2, 3, 4, 5, AND 6 

926 IFINIC.LE.2J GO TO 938 
BUSE = RHOC*B(M) 

I F < B(MJ .LT.O. ) BUSE a RHOC SS*B ( M) 

I F ( IC1.NE.0 ) GO TO 930 
A0( M ) = BUSE*G( 5 ) 

GO TO 931 

930 GO TO (931, 932,933,934), IC1 

931 A1(M) = BUSE*G( IjG-15) 

932 A2(M) = BUSE*G( IJG-10) 

933 A3 ( M ) = BOSE*G( IJG-5) 

934 A4(M) - BUSE*G( IJG)+A4(M ) 

I F ( IC 2-5 ) 938,935,936 

936 A6 ( M ) = BUSE*G( 1JG+10) 

935 A5(M) = BUSE*G( IJG+5) 

MODIFY INFLOENCE COEFFICIENTS TO ACCOMMODATE DOUBLE STREAMLINE 
MT = TRUE POINT 
MX = DUMMY POINT 

MX IS THE FIRST POINT, EXCEPT FOR CASC PROG WITH UPPER 0L8C. 
THEN MX IS THE SECOND POINT. 

938 IF ( W( J ) .NE.O. .OR. SLBDY ) GO TO 940 
MT * M 

MX = M- 1 

I F ( TYPEU8U I.NE.OLBC ) GO TO 19392 
MT = M— 1 

MX = M 

19392 A2 ( MT ) * A2 ( M ) +A2 ( M-l ) 

A3 { MT I s A 3 ( M I ♦A 3 ( M- 1 ) 

A4 ( MT I s A4( M ) +A4( M— l ) 

A5( MT )= A5(M)+A5(M-1 ) 

A6 ( MT ) = A6(M)+A6(M-1 ) 

IF ( MX ,NE .M ) GO TO 19394 

C MX =M AND MT*M-i 

A7 ( M- 1 ) =A7 ( M ) 

A8( M-l )=A8(M) 

RHS V = RHS(M-l) 

RHS(M-i )=RHS(M J 
A7( M) = -1. 




A M ( M ) = 0. 

KH'j IP ) = -RH5V 
GO 0) 19 396 
19 394 A 71 MX ) = 0. 

A8I MX ) = -1 . 

19396 A2 ( MX ) = 0 . 

A 3 ( MX )= 0. 

A4(MX)= 1. 

A5 ( MX ) = 0. 

A6( MX ) = 0. 

C FREE, PRESSURE AND FAk-FIELD BOUNDARIES 

C L OWI K BOUNDARY 

9 AD I F ( IS TAGC.EO. 3) GO TO 9H0 
II I .NOT .SLBOY ) GO TO 950 
1 1 ( .NOT . AX I A ) GO I 0 9 42 
A4IM) = A4(M)-TWUPI*K(M) 

A8(M) = T WOP I *R ( M ■* 1 ) 

GO TO 9B0 

942 A A ( M ) = A A ( M ) — 1 . 

A8 ( M ) = 1 . 

IFITYPELBIL I.NE.FARFLD) GO TU 980 
C ST ARE A= STREAM TUBE AREA 

ST ARt A= R ( M ♦ l )-R ( M ) 

IF(AXIA) STAREA=PI*(R|M)+R(M+1) I* STARE A 
9A5 CALL FFINC 

V QA T S (J= VM(M)*VM(M) / ( AT INF* AT INF ) 

BETA = l.-VQATSQ/ ( 1 .-.2*VQATSQ) 

IFIHETA.GT.O. ) GO TO 94 7 
WRITE (6,1946) M 
CALL ERROR 1 

1946 FORMAT ( 7 6H *** SORRY - SUPERSONIC VELOCITY ENCOUNTERED ON FAR FIE 
1LO BOUNDARY AT POINT, 15, 9M ( MC OEF ) ) 

947 BETA = SORT! BETA) 

BA = BE TA*STAKEA 
A 2 ( M ) = A2(M)-RA*GFF ) 

A 3 ( M ) = A 3 ( M ) -BA* GFF ( 3 ) 

A4IM) = A4(M)-BA*GFF (4) 

A5IM) = A5 ( M) -BA* GFF ( 5 ) 

A 6 ( M ) = A6(M)-BA*GFF (6) 

GO TO 980 

C UPPER BOUNOARY 

950 IF ( .NOT .SUBDY ) GO TO 980 
IF(AXIA) GO TO 964 
A4(M) = A4 ( M ) - 1 . 

A7(M) = 1. 

GO TO 966 

964 A4(M) = A4(M)-TWUPI*k(M) 

A 7 ( M ) = T WOP I *R ( M- 1 ) 

966 IF( TYPEUBIL J.NE.FARFLD) GO TO 980 
ST ARE A= RIM)-R(M-l) 

1 F ( AX I A) STAREA=P1*(R(M)+R(M-1) )* STARE A 
GO TO 945 

980 M = MCENTR+1 

IF(M.LE.MB) GO TO 810 
C END LOOP ACROSS THE STREAMLINES 



C INDEX TO NEXT STATION 
L = L+LNEXT ( L ) 

IF ( L.LT .LESTA ) GO TO 800 
C.....END LOOP THROUGH THE STATIONS 


IF(PDUM(3).EQ.O.) GO TO 990 
WRITE (6,1000) 

DO 100 1=1, NM 

WRITE (6,1001) I*B(I),A2(I),A3(I)»A4(I),A5(I)«A6(I),A7(I),A8(I), 
1 RHS(I) 

100 CONTINUE 
990 RETURN 

1000 FORMAT (4H1 M , 1 1 X , 1HB , 1 OX , 2HA2 , 10X , 2HA3 , 1 OX, 2HA4 , 10X ,2HA5 , 10X, 

1 2HA6, 10X,2HA7,10X,2HA8*21X, 3HRHS ) 

1001 FORMAT (1H , I 3, 8F 12. 3, 12X ,F12.6 ) 

END 




no o on non nonooo non 


♦DECK ATDMRS 

SUBROUTINE ATDMRS 

♦ATDMRS AUGUMENTED TR 10 1 AGONAL MATRIX REDUCTION -ATDMRS- 

C SMALL MATRIX VERSION 


CIVtN I H f MATRIX EOUATION AX =BY * 

FIND G SO THAT X=GY, 

NOTE X AND Y ARE VECTORS. 

INPUT- 

A - TRIDIAGONAL COEFFICIENT MATRIX OF X 

B = TR 1 0 1 AGONAL COEFFICIENT MATRIX OF Y (STORED IN G-ARRAY) 

(OTHER OFF-DIAGONAL ELEMENTS MUST BE INITIALIZED TO ZERO) 
1 0 1 M - FIRST SUBSCRIPT DIMENSION OF MATRIX B AND G 
N - ORDER OF MATRACIES 


ORDER OF 
A( 2, 1 ) 
A( 1, 2 ) 


STORAGE IS ILLUSTRATED 
A ( 3, 1) IA(L,1I) 

A (2*2) A ( 3 » 2 ) 

A < 1,3) A ( 2 , 3 ) A ( 3 * 3 ) 
( A ( 3,4) ) Ad, 4) A ( 2 , 4 ) 


BY- 

B (1*1) 
B (2 , 1 ) 


8 ( 1 * 2 ) 

B ( 2 * 2 ) B ( 2 * 3 ) 

B ( 3 • 2 ) B ( 3 * 3 ) B ( 3 * 4 ) 
8(4,3) 8(4,4) 


OFF DIAGONAL ELEMENTS OF 


B MUST BE SET TO ZERO 


OUTPUT- 

G - INVERSE(A) ♦ B 

COMMON /ERASE / A( 3,100), DUM(500) 
COMMON /CATM / N,IDIM,G(25) 


C ♦♦ * FORWARU REDUCTION 

A( 3, 1 )= A( 3, 1 )/A( 2,1 ) 

G( 1 ) = G ( 1 1 / A ( 2 * 1 ) 

G( IDIM+1)=G(IDIM+1)/A(2,l) 

I = 2 

C SPECIAL LOGIC FOR INCLUDING A(4,l) WHICH IS STORED IN Midi 

A ( 1,1 )= A( 1, 1 )/A( 2,1 ) 

QA2I = l./(A(2,2>-A(l,2>*A( 3,1)) 

A ( 3 , 2 ) = QA21*(A(3,2)-A(l,2)*A(l,l)) 

GO TO 97 


90 UA2I = 1 - / ( A ( 2 , I ) -A ( 1 , I )*A(3*I-1) ) 
95 A ( 3 , I ) = QA2I*A( 3, I ) 

97 J =1 

IJ = I 

120 G ( I J ) = QA2 I ♦ ( G( I J ) — A ( 1, I )*G( IJ-1) ) 
IF(J-I) 140,140,160 
140 IF(J-N) 150,160,160 
150 J = J+l 

IJ = I J ♦ 1 1) I M 

GO TO 120 

160 I F ( I-N) 170, 180, 170 
170 I = I+l 


C SPECIAL LOGIC FOR INCLUDING A(N,N-2) WHICH IS STORED IN A(3,N) 

I F ( I-N) 90, 172,172 
172 A ( 1 , I ) = A( 1,1 )-A ( 3 * I ) * A ( 3 * I -2 ) 





J =1 

IJ = I 

170 G( I J ) = G< I JJ-A(3, I )*G< I J-2) 

179 J * J*1 

IJ * IJ+ID1M 

IF(J-I)178»90»90 


C*** BACK SUBSTITUTION 
180 I = 1-1 

C I F ( I ) 900,900,190 

190 J =1 

IJ = I 

C SPECIAL LOGIC FOR INCLUDING AU,1> WHICH IS STOREO IN AU,U 

192 IF(I-l) 900,195,200 
195 G ( I J ) = G( IJ)-A(l,l)*G(lJ+2) 

200 GI1J) = G( IJ)-A(3, I)*G( IJ + 1) 

IF(J.EQ.N) GO TO 180 
J = J*1 

IJ = IJ+1DIM 
GO TO 192 

900 RETURN 
END 



♦OECK CUBE 

SUBROUTINE CUBE < X , Y, NN ,B ) 

♦CUBE— FIT A SERIES OF CUBICS TO POINTS -CUBE- 

♦ ENO CONDITIONS ARE ARBITRARY 

DIMENSION XI 10) , Y( 10) ,B( 101 

C ON ENTRY - 

C X » Y = LISTS OF COORDINATES 

C N NO. OF POINTS ( N . GE . 2 ) 

C ALSO DEFINED ON ENTRY - IN C OMMON/CCUBE / - 

C NBC ( L ) = BOUNDARY CONDITION INDICATOR FOR L E F T ( L= 1 ) ANO RIGHT ( 1=2 ) 

C = O t 1, OR 2 

C YP(L) = FIRST DERIVATIVE IF NBCIU-l 

C Y PP I L ) = SECOND DERIVATIVE IF NBC(L)=2 

C ON RETURN- 

C R ( I ) = FIRST DERIVATIVE AT POINT I (1 = 1, N) 

COMMON /CCUBE / NRC ( 2 ) ♦ Y P ( 2 ) , YP P ( 2 ) , FEND ( 2 ) 

COMMON /CCUBIC/ N,IA,1B 

COMMON /ERASE / A ( 3 , 2 66 ) , DR A SE ( 2 ) 

LOGICAL PARAB 


C INITIALIZE 


N 

= 

NN 

IA 


2 

IB 

= 

N-l 

DX 1 

= 

X ( 2 ) - X ( 1) 

0Y1 


Y( 2 )-Y( 1 ) 

DXN 


X ( N ) — X ( N— 1 ) 

DYN 


Y (N)-Y( N-l ) 


C NOTE -DXN- IS THE DELTA X FOR THE (N-l) INTERVAL. DXNM1 WOULD BE 

C MORE PRECISE SYMBOL. 

C A STRAIGHT LINE IS USED FOR N=2 IF NBC (1) =NBC ( 2) =0 
NBC S = NBC ( l ) +NBC ( 2) 

IFCN.GT.2 .OR. NBCS.GT.O) GO TO 80 
B( 1) = ( Y { 2 ) - Y ( 1 ) )/(X(2)-Xlll) 

B< 2 ) = b( 1 ) 

GO TO 900 

C CHECK IF PARABOLA (F=01 SHOULD BE USED 

80 PARAB = (N.LQ.2 .AND. ( NBC ( 1 ) *NBC ( 2 ) > . EQ.O > .OR. 

1 (N.F0.3 .AND. NBC S.E (J .0 ) 

C NBC = 0 1 , Y AND YP SPECIFIED 
C LEFT END 

110 IF ( NBC< 1 ) .NE.01 ) GO TO 120 
A( 2, 1 )= 1 . 

A ( 3 » 1 ) = 0. 

B(l) = YP( 1 ) 

C RIGHT END 

120 I F ( NBC( 2 ) .NE .01 ) GO TO 210 
A ( 1 , N ) = 0. 

A ( 2 , N )= 1. 



B(N ) « YPI2) 


C NBC=02* Y AND YPP SPECIFIED 
C LEFT END 

210 IFINBCl 1) .NE.02) GO TO 220 
A( 2 » 1 ) * 4. 

A(3,l ) = 2. 

B( 1 ) = 6.*DY1/DX1 - YPP ( 1 )*DXl 

C RIGHT END 

220 IFINBCI 2 1 • NE.02) GO TO 310 
A( 1 » N ) = 2. 

A( 2,N )= 4. 

BIN) = YPP ( 2 ) *DXN ♦ 6.*DYN/DXN 

C NBC=0* YPPP = F * YPPPIOF ADJACENT INTERVAL) 

C LEFT END 

310 IF(NBCII) .NE.O) GO TO 320 
A( 2 » 1 ) * 1. 

At 3« 1 ) s 1. 

Bill = 2.4DY1/DX1 
IF(PARAB) GO TO 320 
DX2 = X ( 3 )- X ( 2 ) 

DY 2 = Y l 3 1- Y ( 2 > 

DX 10X 2= DX1/DX2 

A ( 2 1 1 ) = A ( 2 » 1 ) ♦ FEND( 1)*DX1DX2 

A(3,l)= A( 3» 1 ) ♦ FEND( 1 ) *0X1DX2* (2.+DX1DX2) 

B ( 1 ) = B ( 1 ) ♦ FEND(1)*(3.*DYUDY2*DX1DX2*DX1DX2)/DX2 

C RIGHT END 

320 IF(NBC(2). NE.O) GO TO 500 
A( 1 »N ) = 1. 

A ( 2 » N ) = 1. 

BIN) = 2 . *DYN/DXN 
IF(PARAB) GO TO 500 
DXM = XIN-1 J-XIN-2) 

OYM = YIN-l J-YIN-2 ) 

DXNDXM= DXN/DXM 

A ( 1 #N ) * A I 1 « N ) ♦ FEND ( 2 ) *OXNDXM* 1 2 . + DXNDXM ) 

A I 2 »N ) = A I 2 « N ) ♦ FEND! 2 ) *DXNDXM 

BIN) = BIN) ♦ FEND! 2)*I 3.*DYN+DYM*DXNDXH*DXNDXM)/0XM 

500 CALL CUB ICStXyYfH) 

900 RETURN 
END 



• deck ccubl 

RLCJCK CATA CUBEBK 

♦CCUllf - DATA FOR /CCUBE / -CCUBE- 

CUMMDN /C CUBE / NBC t 2 ) , VP 12 I , YPP ( 2 ) f FEND ( 2 I 
DATA NHL, YP, YPP ,1 l NO /*»*<) , 6*0 . / 
l NlJ 
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♦DECK CUBERS 

SUBROUTINE CUBERS(X,NN) 

♦CUBERS YPP IN TERMS OF Y -CUBERS- 

C FOR CUBIC SPLINE EQUATIONS 

C SPECIAL SMALL MATRIX VERSION WITH END CONDITIONS FOR -STC 

DIMENSION X(IO) 

ON ENTRY - 

X = LIST OF DISTANCES 

NN = NO. OF POINTS (N.GE.3) 

ALSO DEFINED ON ENTRY - IN COMMON/CCUBE/ - 
NBC(L>= BOUNDARY CONDITION INDICATOR FOR LEFT IL*1 ) AND RIGHT(L»2) 

= 0 IF FEND ( L ) IS SPECIFIED 
= I FOR YP ( L ) *0. 

= 2 FOR YPP ( L ) *0. 

= 4 FOR YP (L)*-C1IL)*Y(U AND YPPP ( L)«FENDI L ) *YPPP I NEXT 
FEND! L ) = END/NEXT TO END VALUE OF YPPP IF NBC(L)»0 

ON RETURN- 

G( 1 , J ) - MATRIX OEFINED BY C=GY WHERE C IS A VECTOR OF SECONO DER 

COMMON /CATM / N , ID IM ,B I 5, 5 ) 

COMMON /CCUBE / NBC ( 2 I , C 1 < 2 ) ,C2 ( 2 ) ,F END ( 2 ) 

COMMON /ERASE / A ( 3, 266) .DRASEI 2 ) 

♦♦♦♦DEFINE COEFFICIENT MATRIC IES -A- AND -B-, WHERE A^YPP-B^Y 


INITIALIZE 



N 

= NN 


FI 

= FEND! 1) 


F2 

= FEND! 2 ) 


IF IN- 

3) 60,65,70 

60 

CALL 

ERROR 1 

65 

FI 

= 0 . 


F2 

= 0 . 

70 

CALL 

SETM I 2 , 0 . , A, 15, 


DXI 

= X ( 2 )-X ( 1) 


0X2 

= XI 3 )-X { 2) 


DXM 

= X ( N- 1 )— XI N-2 ) 


DXN 

= X(N)-XIN-I) 


NOTE -DXN- IS THE DELTA X FOR THE CN-1) INTERVAL. DXNM1 WOULD BE 
MORE PRECISE SYMBOL. 

IA =2 

IB = N-I 


NBC=01, YP *0 . 

LEFT ENO 

110 IF(NBCm.NE.OI) GO TO 120 
A< 2, n= DXH-DXI 
A ( 3, 1 )= DXI 
B I I » 2 I = 6. /DXI 
B ( 1,1 )= - B ( 1,2) 

C RIGHT END 

120 I F ( NBC ( 2 ) .NE .01 ) GO TO 210 
A ( 1 , N ) * DXN 




A I 2,0)-' 0XN*DXN 
BIN.N-l )-6./0XN 
R I N » N ) = -B(N,N-l) 


C NBC = 02 • YPP=0. 

C LEFT END 

210 IFINBCI ll.NI .021 GO H) 220 
A I 2 » l I s l. 

C RIGHT END 

220 I F ( NBC I 2 ) «NE . 02 ) GO TO 310 
A ( 2 » N I = 1. 

C NRC=0, YPPP = F * YPPPIQF ADJACENT INTERVAL) 

C LEFT END 

310 H INBCI 1 J.NE.O) GO IIJ 320 
A ( 1 t l ) = H*0/l 
A( 2, 1 ) = 0X2 
A ( 3 » 1 ) = -DX2-AI 1,1) 

C RIGHI END 

320 I F ( NBC I 2 ) .NE . 0 ) GO TO 410 
A { 3 , N ) = F2*DXN 
A ( 2 , N ) = DXM 
A ( 1 , N ) = -DXM- A 1 3 , N ) 

C NBC=04, YP=C1*Y AND YP PP=F * YPPP I NE XT TO END) 

C LEFT END 

410 IFINBC11I.NE.04) GO TO 420 
CALL ERROR 1 
C RIGHT END 

420 IFINBCI 2) .NE. 04) GO TO 500 
A ( 2 » N ) = 1. 

IB = N-2 
ADXN = C l C 2 ) *DXN 
C1PAD = 1 • ♦ ADXN 

All, N- 1 ) = DXM ♦ F2«‘0XN*DXN/DXM*(3.*ADXN)/C1PAD 
A| 2,N-1 )= A ( 1 , N- 1 ) +DXM* 3.«DXN*( 2 .* ADXN) /Cl PAD 
BIN-1, N-2)=6. /DXM 

BIN-l.N-l )=-6.*l 1 • /OXM+C 1 1 2 ) /Cl PAD ) 

C CUBIC RECURSION FORMULA BASED UN MATCHING YP AND 
500 IF! 1B.LT. I A } GO TO 600 
DO 550 I = I A , IB 
All,! 1 =X I I ) -X I 1-1 ) 

A I 3, I ) = X| I ♦ 1 ) -X I I ) 

A(2» I ) = 2 • * I A I 1,1 > ♦ A ( 4,1) ) 

B I I, I - 1 ) =6 • /A ( 1,1 ) 

B I I , I ♦ 1 ) =6 • / A ( 3 » I ) 

550 Bl I, I )=-B( I, I-D-BU , I ♦ 1 ) 

^^♦♦♦DETERMINATION OF -G- BY MATRIX REDUCTION, YPP=G*Y 
600 I D I M = 5 

CALL ATDMRS 

900 RETURN 
END 



YPP 



♦ DECK cue ICS 

_ SUBROUTINE CUBICS! X, Y,B ) 

♦CUBICS SERIES OF CUBICS FIT TO COORDINATE POINTS -CUBICS- 

DIMENSION XllOO), YllOOIf B ( IOO) 

C INPUT- 

C X( I J, Y< I) 

C A(I,I) ( A(2,I)iA(3,n,B(I) 1*1, II A— 1) AND IMIB+DfN II. E. B.C 

- C I A* 1 B RANGE IN WHICH THE COEFFICIENT MATRIX AND CONSTANT VECTOR 

C BE DEFINED BY EQUATIONS FOR MATCHING YP ANO YPP. 

C 1 1 N RANGE OF X,Y, AND B 

C OUTPUT 

C BII) SLOPE AT X( I) 

“ COMMON /CCUBIC/ N,IA,IB 

COMMON /ERASE / A(3,266). DRASEI2I 

- C SET UP TRIDIAGONAL COEFFICIENT MATRIX A AND VECTOR B. ORDER OF 


C 

STORAGE IS 

ILLUSTRATED 

BY - 



c 

A( 2, 1) 

At 3, 1 ) 



BID 

c 

A 1 1,2) 

Al 2, 2 ) 

At 3,2 ) 


B (2 ) 

c 


A( 1,3) 

A I 2*3 ) 

A ( 3 , 3 ) 

B13) 

c 



A C 1,4) 

A(2 ,4) 

BI4) 


“ C I = POINTS AT WHICH YP AND YPP ARE MATCHED 

C IA.IB = LIMITS OF I 

I F ( IB.LT.IA) GO TO 100 

DO 70 IMA, IB 

A( I, I )= XI I + I )-X( I ) 

_ Ai 3, i >= xi i )-xi i-n 

A ( 2 , I ) = 2 •♦ ( A ( 1 • I ) +A I 3 , 1 ) ) 

70 BII) =3.*l <Y( I+l )-Y( l)J*A<3, IJ/A1 i,I l+CYl I )-YII-l) )*A(1, I )/A(3, I ) 
l ) 

C ROUTINE TDSEO - TRIDIAGONAL SIMULTANEOUS EQUATIONS 
C SOLUTION TO AX = B. ON RETURN SOLUTION VECTOR X IS STORED IN B. 

«- 100 A( 3, 1 ) = A ( 3 , I ) /A ( 2 , 1 ) 

BID = B ( I ) /At 2 , 1 ) 

DO 150 1=2, N 

A(2,I)= A(2» I )-A( 1,1 )*A( 3,1-1) 

A I 3 , 1 )= A ( 3 , I ) / A ( 2 , 1 ) 

ISO BII) = (B(I)-AI1,I)*BII**1)) / A ( 2 , I ) 

I = N 

200 I = I- l 

IF! I.LE.O J GO TO 900 
~ BII) = BII ) — A I 3, I )*B I I* 1 ) 

GO TO 200 

900 RETURN 
~ END 


04 
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♦DECK CUFIT 

SUBROUTINE CUF I T ( X , Y , NP T S , NEW, XC ,YC,NXC ,ND, B) 

CUFIT- “CUFIT” 

INTEGRATE, INTERPOLATE FOR COORDINATES, 1ST, OR, 2ND DERIVAT 
BY A CUBIC SPLINE CURVE FIT 

LOGICAL NEW 

DIMENSION X ( 10 ) , Y ( 10 ) , XC ( 10 ) , YC ( 10 ) , B(10) 

NOTE. THE DIMENSION -10“ DOES NOT NEED TO AGREE WITH THE CALLING 

INPUT- 

X, Y PTS. ON CURVE 

NPTS NO. OF X 

NEW =1 I. TRUE.) TO FIT CURVE, =0 (.FALSE.) TO USE LAST FIT 

XC LIST OF X AT WHICH CALC TO BE DONE 

YC ( 1 ) INTEGRATION CONSTANT IF ND=-1 
NXC NO. OF XC 

NO =0 TO GET COORD, =1 OR 2 TO GET 1ST OR SECOND DERIV. 

= -l FOR INTEGRATION 

OUTPUT 

YC COORDINATE OR DERIVATIVE AT XC OR 

YC(IC)= INTEGRAL ( Y^DX) FROM XC (1) TO XC(IC) WHERE IC=2,NXC 
B ( I ) FIRST DERIVAT AT POINT I (1=1, N) 


NOTES- 

-X- MAY BE IN EITHER ASCENDING OR DESCENDING ORDER. 

FOR INTEGRATION -XC~ MUST BE IN THE SAME ORDER AS “X“. FOR INTERP 
NO SPECIAL ORDER IS REQUIRED. 

LOGICAL WITHIN 

C FIT THE CUBIC SPLINE 

IF ( .NOT .NEW ) GO TO 100 
CALL CUBE ( X,Y, NPTS , B) 

C INTERPOLATE 

TOO I =1 

DO 150 I C = 1 , NXC 

C LOCATE APPROPRIATE INTERVAL 

W I THIN= .FALSE . 

NCOUN T =NP T S 
N = NCOUNT-1 

101 NC0UNT=NC0UNT-1 

IF< NCOUNT.EQ.O) GO TO 120 

F = ( XC ( IC )- X ( I ) ) / ( X ( I ♦ l )-X ( I ) ) 

I F ( F . GE .0 . ) GO TO 110 

F.LT.O. 

IF ( I .EQ.l ) GO TO 125 
IFIND.EC. (-1 ) ) GO TO 120 
I =1-1 

GO TO 101 

1 10 IF( F.LE . 1. ) GO TO 125 


C 
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C F.GT.1.0 

_ IFl l.EQ.N) GO TO 125 

IF( ND.EQ. (-1 ) ) GO TO 126 
112 I » I + l 
GO TO 101 

120 CALL ERROR l 

- C PRELIMINARY CALCULATIONS FOR INTERPOLATION OR INTEGRATION 

125 W I TH I N= .TRUE . 

126 OX = X( I+l )-X ( I ) 

_ DY = Y ( 1+1 )-Y( I ) 

D = (B( I)+B< I+1)-2.*DY/DX)/(DX*DX) 

C * ( 3.*0Y/DX-(2.*Bm+B( I + im/DX 

XD = XC( ICI-XU ) 

- L ND+2 

GO TO ( 130, 1 AO , 14l,l42),L 

_ C ND=-1, INTEGRATE 

130 I F C .NOT. WITHIN) XD=DX 

SI = ( Y ( I ) ♦ (B(Ii/2. ♦ (C/3. ♦ D/4.*XD)*XD)*XD)*XD 

IF(HITHIN) GO TO 135 

-I- IS BEING INCREMENTED TO FIND APPROPRIATE INTERVAL. HENCE, 
CUMULATE THE INTEGRAL OF THE I TH INTERVAL. 

SA = SA ♦ SI 
GO TO 112 

C APPROPRIATE INTERVAL FOUND. X( I )-XC ( ICI-XI I+i ) 

135 I F C IC.EQ.l) SA=YC(IC)-S1 
_ I F t IC.NE.l ) YC ( IC )=SA*S1 

GO TO 150 

C ND=0 , INTERPOLATE FOR COORDINATES 

1 AO YC ( IC ) = Y(I) + ( B ( I ) ♦ <C ♦ D*XD ) *XD ) *XD 

GO TO 150 

- C ND=1, FIRST DERIVATIVE 

1A1 YC ( IC ) = B(I) ♦ ( 2 . *C ♦ 3.*D*XD)*XD 
GO TO 150 

C ND=2 » SECOND DERIVATIVE 

1A2 YC(IC)= 2. *C + 6.*D*XD 

“ 150 CONTINUE 




RETURN 

ENO 
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♦ m ok r.ui 1 1 r 

SUDHUUT I NE CUF 1TR(X,N1C,IMID) 

♦CUFITB TEMPORARY ROUTINE FUR 

DETERMINING INFLUENCE COEFFICIENTS 
FOR INFIELD BOUNDARY POINTS 
WHICH TERMINATE -PARTIAL ORTHOGONALS- 

DIMENSION X(A) 

COMMON /CATM / NX , XIJ I M, G ( 5 , 5 ) 

DIMENSION Y<M ,B<4 ) 

X I - X ( I M I IJ ) 

C SHIM X-ILEMENTS A BOV! -IMID- TO THE LEFT 
NMOVI = NIC-IMID 

CALL MOVE I 1» XI IMIO+1 ),X( I MID) ,NMOVE , 1) 

N I = NIC - 1 
DO 60 I = 1 » N I 
DO 50 II=1,NI 
50 Y ( I I ) = 0. 

Y ( I ) =1. 

60 CALL CUFITI X,Y, NIC-1, .TRUE., X3,G I 1 MI D, I ) , 1 , 0,B ) 

C SHIFT G ( I M I D , I ) TO THE RIGHT FOR I.GT.IMID 
I = NI 

70 Gf IMIO, I+l ) = G ( I M ID , l ) 

I =1-1 

I F C I.GE.IMID) GO TO 70 
GIIMIU, IMID»*-1. 

RETURN 

END 



-CUF I T R- 



• OECK FF INC 

SUBROUTINE FF INC 

CFFINC INFLUENCE COEFFICIENTS ON 


COMMON 

/CFB / 

L tMA yMBt DFBI 301 

COMMON 

/CFFINC/ 

GFF( 6 ) 

COMMON 

/CFRFIN/ 

DM ( A ) f ZDNlt ZDN2 5 

COMMON 

/CIDEX / 

MtJfMUfMD»ISTAG 

COMMON 

/CSI / 

SI ( 300) 

COMMON 

M 

/Cl / 

: MB 

l ( 300 ) 


FAR FIELD BOUNDARY 


CALL GET I X 

QOS I = 2./CSlCMD)-Sll MU ) ) 

C COMPUTE INFLUENCE COEFFICIENTS 
GFF ( 2 I * 0. 

GFF<6>= 0. 

I F ( MU.EQ.O .OR. MO.EQ.O ) GO TO 20 
GFF<3)= - .B65*QDS 1 
GFF ( A ) = -2.*GFF ( 3 ) 

GFF ( 5 ) = GFF ( 3 ) 


20 


25 


2 


GO TO 2 
GFF ( 3 I = 0. 

GFF ( 5 )=0. 

I F I MD.EQ.O ) GO TO 25 
OSI * SKMD)-Sl(M) 

GFF ( 5 ) = -,865/DSl 
ZL = Z (M J-ZDNI 
RATIO = ( < ZL-DS1) /ZL J**2 
GFF ( A ) = GFF(5)*(RATI0-2. ) 
GO TO 2 

OSI = Sl(M)-SKMU) 

GFF ( 3 ) = - • 865/DSi 
ZL = ZDN25-ZIM) 

RATIO = ( ( ZL-DS l ) / ZL )**2 
GFF ( A )= GFF( 3)*(RATI0-2. ) 
RETURN 
END 


-FFINC 
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* lit CK I A [) 

SUBROUTINE I AD 

* I A D IMPLICIT ALTERNATING DIRECTION ROUT INF — STC - I AD- 

C INPUT 

0 Ml h ,MUB, I 0, 1 NI X T STATION TABLE 

L B ( M ) « I NO I C A I OR ( B . G I . 0 - - SUBS ON I C ) (B.IT.O — SUPERSONIC) 

f. A 1 , A/ , A 5 , AA , AS, AG, A 7 , AH - INEIULNU COEEUCIENTS 

C RMS(M) R 1 GH I HAND S 1 1)1 S 01 MAIRJX EQUATION 

A A I M ) = 1. fOR I 1RST POINT OE DOUBLE STRIAMLINE 
I ADM - -1 LINE RELAXATION ALONG ST RT AML I Nf 

I A DM = 0 ALTERNATING ORTHOGONAL, STREAMLINE RELAXATION 

I ADM - 1 LINE RELAXATION ALONG ORTHOGONAL 

COMMON /CB / B(iOu) 

COMMON /C0S2 / 0 S 2 ( '3001 

COMMON / C R H S / ROSE TOO) 

COMMON /CA2 / A2I300) 

COMMON /CA3 / A3 (300) 

COMMON /CAA / A A ( 300 ) 

COMMON /CA5 / A5E300) 

COMMON /CA6 / A 6 ( 300 ) 

COMMON /CA7 / A 7 ( 300 ) 

COMMON /CA8 / A8E300) 

DIMLNSION A1 ( 300 ) ,A0( 300 ) 

E UU I VALENCE ( A 1 , A 5 ) , ( A j , A6 ) 

COMMON /CDDS2 / DDS2 
COMMON /CIADIN/ RHQB AS ,KHUAMP , l ADM 
COMMON /CL BL / L BL , L SS ( 2 ) , Lb LDUM ( 5 ) 

LOGICAL LBL 

COMMON /CMAXIT/ M AX I T , NR E F l N , OUMI T I 2 I 
COMMON /CPI / P I ,DUMP IIS) 

COMMON /CTOLRL/ TOLRL , MA X SWP , CL tN , DS2MX , T0LES2 ,NS WP , DTOLRL ( ft ) , 

* SG1MIN, TOLINK 
STATION TABLE 

INDEX- L=LO»LESTA 

SCHOK E = STATION CHOKE INDICATOR ( AD JWF , BRHS , WR IOUT ) 

MCL = SHARP CORNER INDICATOR IBLDTBSI 

MCL * FIELD INDEX OF CONTROL STREAMLINE ( PT MOV E , F LOBAL ) 

COMMON /CHOATA/ X 1 ( 1 ) , LNL XT ( 1), ML Bill , MUB (I),PRIM(l), 

I TYPE LB ( 1 J , NAMLLB ( 1 > , I LB El) , FLB ( I ) , S 1 L B ( 1 ) , 

1 TYPEUBE 1 ) ,NAMEUB ( I ) , IUBE1 ) ,FUB(1 ) ,SIUB< 1 ) , 

3 VMBI l ) , DWDV ( 1 ) , X2CL (1) , VC L ( I > ,MCL ( AS 1 ) 

LOGICAL PRIM 

INTEGER TYPEL B , TYPE UB 
DIMLNSION SCHOKE(l) 

EQUIVALENCE ( SCHUKE , DWDV ) 

C TABLE OF INDEX LIMITS 

COMMON /IXORIG/ L HO , LHE » LBDO ,LBDE , L TO, L Tfc , LWO.LWE, LFO,LFE, 

* LO.LESTA, LDUMI8), 

* MU ,NM , N J ,NF COL S , MA XN J , MA XOL , MA X NM , MAX L t , 

* LLO, LEE , LRO , LRE » LRD 

DIMENSION LIMITSI2A) 

EQUIVALENCE (LIMITS, L HO ) 

COMMON /CM / JMSI300) 

COMMON /CIDEX / MM2 , J S , M 1 , MDN , I ST AG 

COMMON /CIDEXR/ M , MJ 1 ( A ) , M 3 , M J2 ( A > ,MS ,MJA ( A I , M?, MJS ( A ) , M6,MJ6( A > 
COMMON /ERA St 2/ AAAI 128) , AA8I 12 8 ) , HH 1 1 28 ) , AA 1 ( 12 H ) , AA2 I 1 28 ) , 

* MSAVE I 128 ) ,DKASL I 732 ) 
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COMMON /CPRINT/ PDUMI6 ) * PRT ( 20) 

COMMON /CSS / SSFML , SSEF,SSEANG , SSDF ,SSF£ND,SSFND1 
1 « S SOLE ,A4F ACT ♦ BRLX ,CURRLX, TSIC ,RHOC»RHOCSS 

INTEGER SSFML 

LOGICAL SSEF, SSDF, SSOLE 


C INITIALIZE DS2 TO 0., NSWP«0 
CALL SETMU,0.,0S2,NM) 

NSWP » 0 

ASSIGN 235 TO LGO 

ALIM = SORT ( FLOAT! NM J ) 

L IMSWP= MAXSWP-IF IX( ALIM )-2 

FNM * 1./ALIM 

CLENX = 4.*SG1MIN 

ITYPE » I ADM + 2 

XXK a o. 

RHO * RHOBAS 

C LOOP TO SWEEP THROUGH STATIONS 
LSTART= LO 
LEND = LESTA 
I F ( .NOT.LBL I GO TO 1 

IF< L SS ( 2 ) .EQ .0 .Or. LSS ( 2 1 . LT. LSS ( 1 > ) RETURN 
C SET LIMITS FOR LINE BY LINE SUPERSONIC SOLUTION 
ITYPE » 2 
LSTART* LSS ( 1 ) 

LEND * LSS( 2 ) ♦ 1 

1 L = LSTART 

DS2MX « 0. 

0DS2 = 0. 

I F ( RHOAMP.EQ.O. 1 GO TO 111! 

C COMPUTE RHO —ITERATION FACTOR 

XXK = XXK + 1 • 

I F ( XXK. GE. ALIM ) XXK»1. 

TSIN = SIN< .5*XXK*PI*FNM) 

RHO = RH0BAS+2.*RH0AMP*TSIN**2 
1111 RHO 1 » l • -RHO 

GO TO (200,2,2) , ITYPE 
C LOOP ACROSS STREAMLINES 

2 MA = MLB(L) 

MB = MUB(L) 

IF(NSWP.GE.LIMSWP) PDUM ( 3 ) *1 • 

M a HA 

3 K = 0 

4 K a K + l 

BUILO COEFFICIENT TABLES FOR TOSEO ON ORTHOGONAL 
GET M2 ,M3,M5,M6 INDICES 
CALL GETRLX 
C CALCULATE MODIFIED RIGHT HAND SIDES 

I F ( B(M).LE.O. ) GO TO 20 

C SUBSONIC BRANCH 

10 AAAI » -( A2<M>*A3<M)+A5<M)*A6(M>) 

AA 42 = A4( M ) -AA4 I 

BB( K ) > RHS(M)-(A2(M)*DS2(M2)+A3(M)*DS2(M3)+RH01*AA41*DS2CM) 
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♦ 4A SC M )♦!>:, t (MS )+A6(M)*DS2<M6>) 

AAAK = AAA2+RH0+ AAA 1 

GO TO JO 

SUPl KSON I C BRANCH GL T INDEX— Ml 

SPECIAL 5 POINT CUBIC-- SSFML=3. PICK UP AO 

20 Ml = M2 

21 MM2 = Ml 
CALL GETIX 

I F C M1.EQ.0 ) M1 = M 
I F ( ISTAG.EQ.3 ) GO TO 21 
M1SAV = Ml 
2b MM2 = Ml 
CALL GfcllX 
IH Ml.TU.O ) M 1 =M 
lf( I!, TAG. EO. 3 I (.0 10 2b 
MO = Ml 
Ml = M1SAV 

AAAI = -<A2(MUA3(M)*A1 I M 1 ♦ A 0 C M 1 > 

AAA2 = AA ( M I -AAA 1 

BB ( K ) = RHS(M)-(A1<M)*DS2(M1)+A2(M)*DS2(M2)+A3(M)*DS2(M3)+RH01* 

* AAA1*0S2(M) ♦A0(M)*DS2(M0)) 

AAAK = AAA2 + RH0* AAA 1 

I F ( SSFML.EQ.3) GO TO 29 

TRIDIAGONAL DECOMPOSITION 

IF A6( M ) =0* ADJUST LOCALLY TO RH0=1 

30 I F ( A6(M).NE.O. ) GO TO 31 

29 BB(K) = BB(K)+RH01*AAAl*0$2(M) 

AAAK = AAAK+RH01*AAA1 

31 I F ( K.GE.2 ) GO TO 50 
A A8 ( K ) = A8 ( M ) /AAAK 

BB ( K ) = BBC K) /AAAK 

GO TO 61 

FORWARD DECOMPOSI I ION 

SPECIAL LOGIC FOR 2-NO OF DOUBLE POINTS 

50 IF(AA(M).NE.1.» GO TO 51 
GO TO 60 

51 IF(AA(M-l).NE.l.) GO TO 60 
I F ( BCMJ.LE.O. ) GO 10 52 

AAAI = -( A2CMJ ♦A3(M)4A5CM)+A6(M)» 

GO TO 53 

52 AAAI = -( A2(M)+A3(M)+A1(MJ) 

53 AAA 2 = AACMI-AAAl 

AAAK = AAA2 + RH0* AAA 1 

I F ( A6CMJ.EQ.0. .OR. (B(M).LE.O. .AND. SSFML.EQ.3 ) ) 

♦AAAK = AAAK +RH01* AAAI 
AAAK = 1./(AAAK+A7CM)*AA8(K-2) *AA81K-1J) 

AA8CK ) = A8 ( M I * AAAK 

BB ( K I = (BB(K)-A7(M)#(BB(K-2)-AA8CK-2)*BBIK-1 »I)*AAAK 
GO TO 61 

60 AAAK = l./( AAAK-A7C M)*AAH(K-1) ) 

AA8 l K I = A8(M)*AAAK 

BBCK) = (BB<K)-A7(M)»BB(K-l) )*AAAK 
I F ( M.GF.MB ) GO TO 62 
M = M ♦ 1 

GO TO A 


61 
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0S2 ( M ) * BB( K ) 


C BACK SUBSTITUTION 

70 H * M-l 

K * K-l 

IF C M.LT.MA ) GO TO 100 

BB ( K ) = BB(K )-AA8(K)*BB( K+i) 

C CALCULATE DDS2»DS2MX 

62 0DS2 * AMAX1 ( 0DS2t ABSI BBI K ) -DS2 I MM ) 

DS2 ( M ) = BB ( K ) 

DS2MX = AMAXL ( DS2MX , ABS ( DS2 ( H) I ) 

GO TO 70 

C INDEX TO NEXT STATION 

100 I F ( DS2MX.GT .CLENX ) CALL ERR0R1 
L = L+LNEXT ( L ) 

I F ( L.LT.LEND ) GO TO 2 
C INCREMENT SWEEP COUNTER 

NSWP = NSWP+1 

I F l PDUM( 3 ) .NE.O* ) CALL TABPRT I5HDS2-A«DS2 »NM,NJ) 

I F ( PDUMI 3) .NE.O. ) WRITE <6t999) 0DS2«0S2MX 
999 FORMAT ( //6X » 5HDDS2 = » lPE16.8 f 6X, 6HDS2MX«t E16.8// I 
I F ( IAOM.EO.l .OR. LBL ) GO TO 321 

LOOP TO SWEEP CROSS-STREAM ALONG STREAMLINES 
NOTE*** ISTAG=3 POINTS ARE SKIPPEO 
200 J2 =NJ 
DS2MX * 0. 

DOS 2 = 0. 

202 M * MBEGINI J2 ) 

C CONSTRUCT MATRIX COEFFICIENTS ALONG STREAMLINE 

K =0 

203 K = KU 

C GET INDICES M2,M3tM5,M6 

205 MSAVE(K)* M 
CALL GETRLX 

C IF B(M ) ,LE.O.— ( SUPERSONIC— SUBTRACT A1*DS2(M1) FROM BB 
C IF SSFML.E0.3 ALSO SUBTRACT A0*DS2(M0) FROM BB 
A41K = -<A2(M)+A3(M)+A5IM)+A6(M) J 
I F t BIMI.LE.O. ) A41K=A41K+A5(M)+A6(M) 

A42K = A4(M)-A4lK 
AA4K = A41K*RH0*A42K 
MOB * M— l 

I F ( A4( M- 1 ) .EG. I . ) MDBsM-2 

BB(K) * RHSlM)-U7IM)*DS2(MDB) + RH0i*A42K*DS2(M) 

* ♦A8(M»*DS2IM*in 

I F C BIMJ.GT.O. ) GO TO 206 
Ml = M2 

2051 MM2 = Ml 
CALL GET I X 

I F ( M1.EQ.0 ) M 1®M 
I F I I STAG. EQ. 3 > GO TO 2051 
M1SAV = Ml 

2052 MM2 = Ml 
CALL GET IX 

I F ( Mi.EQ.O ) M l=M 
I F ( I ST AG. EO. 3 I GO TO 2052 
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MO 

Ml 

BB( K ) 


Ml 

M1SAV 

BB ( K ) - A l (M)*DS2(M1)-A J(M)*DS2(MO) 


Pf N r A-f) I AGONAL MATRIX-- DECOMPOSITION 
ADJUST TO RHO=l IF A7(M)=0. 


206 

I F ( A7(M).NE.O. 

) GO 10 2 )7 


HH( K ) 

= BB(K ) ♦ R HO 1 * A 4 2 K * D S 2 ( M ) 


AA4K 

= AA4K*RH0l*A42K 

207 

I F ( K 

. GT . 2 ) GO 

(U 220 


GO TU 

( 208,210) 

, K 

20b 

CM 

= 1./AA4K 



A41(K )= A5(M)*CM 
I F ( B(M).LE.O. ) A41 ( K ) - 0 • 

A4 2 ( K I- A6( M ) *CM 

I F ( B ( M ) .LE .0 . .AND. SSFML.EQ.3 ) A42(K)=0. 

BB ( K ) = BR ( K ) *CM 
GO TU 225 

210 CM = l./(AA4K-A3(M)*A4l(K-l> ) 

A41(K )= l A5(M)-A3( M) *A42 C K — 1 > >*CM 
I F C B(M).LE.O. ) A41 ( K ) = A 4 l ( K )- A5 ( M ) *CM 
A 42 ( K ) = A6«M)*CM 

I F ( B ( M ) .LE .0. .AND. SSFML.EQ.3 > A42IK) = A42 ( K ) -A6 ( M ) *CM 
BB ( K ) = (BB(K)-A3(M)*BB(K-1) )*CM 
GO TO 225 

220 CMA = A3(M)-A2(M)*A41( K-2) 

CM = l./(AA4K-A2(M)*A42(K-2)-CMA*A41(K-l) > 

A41(K)= ( A5(M)-CMA*A42(K-1) )*CM 
1 F ( B(M).LE.O. ) A41(K) = A41U)-A5(M)*CM 
A42(K )= A6(M)*CM 

I F ( B(M).LE.O. .AND. SSFML.EQ.3 ) A42(K) - A42 ( K ) -A6 ( M ) *C M 
BB ( K ) = ( BB(K )-A2(M)*BB( K-2)-CMA*BB(K-l) )*CM 
225 I F ( M5.EQ.M ) GO TO 230 
M = M5 

GO TO 203 

C BACK-SUBSTITUTION LOOP 

230 ASSIGN 231 TO JGO 
GO TO 250 

231 K = K-I 

ASSIGN 240 TO JGO 

BB ( K ) = BR(K )-A41 (K)*BB( K*1 ) 

M = MSAVF(K) 

GO TO 250 
240 K = K-l 

M = MSAVF. (K) 

I F ( K.LI.I ) GO TO 300 

BB ( K ) = BB(K)-A4im*BB(K + i)-A42(K)*BB(K+2) 

C CALCULATE DDS2,DS2MX 

250 DDS2 = AMAX 1 ( DDS2 ,ABS(BB(K)-DS2(M)> ) 

DS2 ( M ) = BB ( K ) 

DS2MX = AMAX1(DS2MX»ABS(DS2(M) ) ) 

GO TO JGO , (231,240) 

300 I F ( DS2MX.GT.CLENX ) CALL ERRURi 
J 2 = J2-1 

I F ( J2.GE.1 ) GO TO 2J 2 




I F C PDUM(3).NE.0. ) CALL TABPRT ( 5HDS2-B.DS2 ,NM,NJ> 
IF( POUM( 3).NE.O. > WRITE (6,999) DDS2,DS2MX 


C INCREMENT SWEEP COUNTER 

320 NSWP » NSWP+I 

C STREAMLINE SWEEP COMPLETE— CHECK CONVERGENCE 

321 I F ( DOS2.L£.TOLRL*OS2MX ) GO TO 900 
I F ( NSWP.LE.MAXSWP ) GO TO I 
ASSIGN 234 TO LGO 

900 I F ( PRT(2).EQ.O.) GO TO 902 

CALL TABPRT ( 5HDS2-F , 0S2 » NM,N J ) 

902 GO TO LGO , (234,235) 

234 CALL ERROR 1 

235 RETURN 
END 


np\ 
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♦ DECK SS5PTI 

SUBROUTINE SS5P T I ( XX ,G ) 

♦SS5PTI SUPERSONIC 5-PT INFLUENCE COEFFICIENTS -SS5PTI- 

DIMLNSIfJN XX(S),G<25) 

INPU f - 

XX = STMIAMWlSt DISTANCE OT TOUR POINTS, XX(l),..X(A) 

OUTPUT - 

G * CHANGE IN SECUNU DERIVATIVE, D2YDX2, PER UNIT CHANGE IN 

YY(0),...YU) 

COMMON /CSS5PT/ X(A),YlA), X2 1 , X3 1 , X 32 t XA 1 , XA2 , XA 3 • AO , A1 , A2 , A3 , AA 

C X C 0 > = 0. 

DO 6b 1=1, A 

65 X( I ) = XX( 1 + 1 )-XX( 1 ) 

CALL SS5PT 
G( 5 ) = AO 

G( 10) = A 1 
G( 15) = A2 
* A3 
G( 25 ) = AA 
RETURN 
END 



